はじめに
三か月前に、こういう記事を書きました。Excel のユーザーフォームを、会話するだけで作れるようにした、という話です。
あれは 作る 話でした。白紙から「ボタンを足して」「もう少し右へ」と言えば、そのとおりに部品が置かれる。そこまではできていました。
この記事で題材にするのは、そうやって育ててきたフォームのうちの1本です。ワークシートの管理に使っているものです。
ところが、その道具には片側しかありませんでした。すでにできあがっているフォームを、AI は読めなかったのです。
だから直すときは、こうなります。私が「なんかこのボタン変だよ」と言う。AI が当てずっぽうで直す。私が実際に開いて見る。まだ変だ。もう一度直す──。書き込むことはできるのに、読み戻せない。フォームだけが、ずっとそういう部品でした。
その片側が、この夏に埋まりました。今回はその話です。
TL;DR
- フォームを保存している
.frmを開いても、**部品の形はどこにも書いてありません。**実測したら、498行のうち設計に関わるのは 8行目の1行だけでした。残りは相方の.frxという 8,216バイトのバイナリの中です - そこで
.frxを解読する道は選びませんでした。代わりに 「同じものをもう一度作る VBA」 を書き出す形にしました。設計図を読むのをやめて、組み立て手順書を書いたわけです - 手元のフォーム1本が 765行 / 35,193文字の VBA になりました。貼って1回実行すると、同じフォームが出てきます
- 発想そのものは私が考えたものではなく、**Gemini に教わりました。**私は Gemini と Claude を二刀流で使っていて、これは Gemini 側から来た話です
- **1本目は盛大に壊しました。**フォームが開かなくなり、丸ごと戻してもらっています。そこで踏んだ落とし穴3つが、そのまま道具の中身になりました
- 道具に畳んだ結果、手元の 22本が 3.4秒で組み上がるようになりました
- そして副産物のほうが大きくて、**AI がフォームの構造を読めるようになりました。**入れ子も、作る順番も、全部コードの行として出てきます
- この記事の題材にしたフォームの 765行を、末尾にそのまま置いてあります。呼び出す側のマクロも、実際に使っているものをそのまま載せました
.frm を開いても、フォームの形は入っていません
まず、何が困っていたのかを実物で見ます。
ユーザーフォームは、書き出すと .frm と .frx の2つのファイルになります。.frm はテキストなので、開けば読めます。読めるなら困らないはずです。
ところが、中身がこうでした。
VERSION 5.00
Begin {C62A69F0-16DC-11CE-9E98-00AA00574A4F} ワークシート一覧
Caption = "ワークシート一覧"
ClientHeight = 5670
ClientLeft = 110
ClientTop = 460
ClientWidth = 5750
OleObjectBlob = "ワークシート一覧.frx":0000
StartUpPosition = 1 'オーナー フォームの中央
End
テキストで読めるのは、フォーム自身の6項目だけです。題名と、外枠の寸法。それだけ。
中に入っている部品は、このフォームの場合 22個あります。ボタン、リスト、タブ、入力欄。その位置も、大きさも、フォントも、色も、タブの順番も、全部 OleObjectBlob という1行の向こう側にあります。
この .frm は全部で498行ありました。**そのうち497行は、部品とは関係ありません。**内訳はこうです。
| 部分 | 分量 | 中身 |
|---|---|---|
| 表紙 | 6行 | 題名と外枠の寸法 |
| 設計図への参照 | 1行 | OleObjectBlob = "…frx":0000 |
| 属性の行 | 5行 | モジュールとしての設定 |
| フォームの中のコード | 約480行 | 動作。押したら何が起きるか |
つまり .frm は 動作の仕様書であって、設計図ではありません。
では設計図はどこかというと、相方の .frx です。8,216バイト。先頭を覗くとこうでした。
4C 42 08 00 00 20 00 00 00 00 00 00 00 00 00 00
52 17 00 00 60 18 00 00 D0 CF 11 E0 A1 B1 1A E1
D0 CF 11 E0 A1 B1 1A E1 は、複合ファイルの目印です。要するに、このファイルの中にもう一つファイルの仕組みが入っている、という構造になっています。読める文字は1つも出てきません。
動きは読めるのに、形だけが読めない。 ボタンを押したら何が起きるかは全部見えているのに、そのボタンがどこにあって何色なのかは、:0000 の向こう側にあって触れない。AI にフォームの相談をすると毎回「実際に開いて見てください」になっていたのは、腕の問題ではなく、この構造のせいでした。
発想は、Gemini から来ました
私は普段、Gemini と Claude を両方使っています。用途で使い分けているというより、思いついたほうに聞く、くらいの雑な二刀流です。
その Gemini との雑談で、こういう話が出ました。
「ユーザーフォームは、マクロで作れる」
デザイナで手で置くものだと思っていたので、これは意外でした。試しに作らせてみたら、たしかにフォームらしきものが出てきます。ただ、細かいところの精度はいまひとつでした。
そこで Claude に振りました。「Gemini からこういうやり方を教わった。君ならもっと精度高く作れるんじゃないか」
これが出発点です。**発想は Gemini、実装は Claude。**私がやったのは、片方から持ってきて、もう片方に渡したところです。
なお、この時点では「AI にフォームを読ませたい」なんて一言も考えていません。単にフォームがコードで作れるらしいという、それだけの話でした。後から振り返ると、この入口だったからうまくいったのだと思っています。読ませるつもりで始めていたら、たぶん .frx を解読する方向へ行っていました。
1本目で、盛大に壊しました
最初の題材に選んだのが、ワークシートの管理フォームでした。今回この記事の末尾に貼るものと同じフォームです。
うまくいきませんでした。当時の私の発言だけ並べると、こうなります。
- 見る限り、まったく違うものになっている
- フォームが開かなくなった
- 直したはずのものが、また壊れている。バックアップから丸ごと戻してほしい
- ワークシートの移動を実行すると Excel ごと落ちる
途中で一度、Claude の別のモデル（フェーブル）に切り替えてもいます。**「クロードはうまくできないんだよ。君がなんとかしてくれよ」**と頼みました。
正直に書くと、ここは1時間や2時間では済んでいません。
ただ、壊れた分だけ分かったことがありました。3つです。
① 消したフォームの名前は、すぐには使えません
同じ名前のフォームを作り直すとき、素直に考えれば「古いのを消してから、新しいのを作る」です。これが通りません。削除した名前は Excel を閉じるまで握られたままで、その名前では作り直せないのです。
なので、消さずに逃がします。
' 同名のフォームがあれば、消さずに改名して逃がす。
' 削除した名前は Excel を閉じるまで VBE が握ったままで、その名前では作り直せない。
' 改名なら名前がすぐ解放されるので、この実行の中で作り直せる（最後に古い方を消す）。
If Not 既存 Is Nothing Then
For i = 1 To 999
Err.Clear
On Error Resume Next
既存.Name = "旧" & フォーム名 & i
On Error GoTo 0
If Err.Number = 0 Then Exit For
Next i
End If
「旧ワークシート一覧1」へ改名して逃がし、新しいほうが完成してから古いほうを消します。途中で失敗しても、元のフォームは残ります。
② 1つの手続きに入る文字数に上限があります
コードの多いフォームだと、書き出したものが1本の手続きに収まりません。28,000文字あたりで切って、「〜作成つづき2」へ送る形にしました。手元の22本のうち 13本が実際に分かれています。
③ 見えていないページの中身は、寸法が当たりません
これが一番いやらしい落とし穴でした。タブで切り替える部品の中にリストを置くと、**表示していない側のページにあるリストは、高さを指定しても効きません。**しかも表示中のリストは、行数の倍数へ勝手に丸められます。
答えはこうなりました。
' リストの高さ（行数の倍数への丸めを避けるため最後に当て直す）
' 表示中のページに載っているリストは当てた瞬間に丸め直される。
' そのリストのページを一度隠してから当てると、戻しても残る。
dsn.Controls("MultiPage1").Value = 1
DoEvents ' ページの切り替えを効かせてから当てる
dsn.Controls("ListBox1").Height = 186
dsn.Controls("MultiPage1").Value = 0
DoEvents ' ページの切り替えを効かせてから当てる
dsn.Controls("ListBox全").Height = 154
dsn.Controls("MultiPage1").Value = 0 ' 既定のページへ戻す
当てたいリストのページを、いったん隠してから当てる。 理屈は後から分かりましたが、最初は「なぜか高さだけ言うことを聞かない」という現象として出てきます。
手で1本ずつ作れた時点で、止めませんでした
こけながらも、1本ずつなら作れるようになりました。ショートカットの管理フォーム、リストのフォーム、AI のフォーム──順に頼んで、順に通りました。
ここで、私はこう言いました。
これでやり方わかったろう。次やる時にスムーズにやれるようにすればどうすればいい? VBAマネージャーに組み込んだりすればいいのか?
いま振り返ると、ここが分かれ目だったと思います。
1本ずつ作れるようになった時点で、けっこう満足していました。実際それでも十分に便利です。でも**そこで止めると、次に頼むときはまた同じ会話から始まります。**さっきの落とし穴3つは、頼むたびに踏み直すことになる。
なので、**道具の側に畳んでもらいました。**私が普段使っている VBA 管理ツールに、フォームを書き出す機能として組み込む。
翌日、こうなりました。
py vba_manager.py form-to-vba ワークシート一覧
→ _ワークシート一覧_作成マクロ.vba (765行 35193文字)
そして全部まとめて書き出す指定を付けると、**手元の22本ぶんの作成マクロが一気に出てきます。**それを順に実行する親マクロを1本作って、押してみました。
22本すべてが組み上がるまで、3.4秒でした。
デザイナで手で置いたら、1本あたり数分から十数分。全部で数時間かかる分量です。1フォームあたり0.15秒。
速い理由は、途中に何も挟まっていないからです。ファイルの読み書きも取り込みも通らず、部品を直接生やしているだけ。フォームが「重いもの」に見えていたのは、置く作業が人間の手だったからで、中身は文字と数字の代入でしかなかった、ということでした。
出てきたコードを見て、思っていたのと違うことに気づきました
ここからが、この記事の本題です。
作ったときの目的は「フォームを作り直せること」でした。ところが出てきた765行を眺めていて、別のことが起きているのに気づきました。
AI が、フォームの構造を読めるようになっていたのです。
しかも「データが取れるようになった」のとは違います。読めるものの質が変わっていました。
① 入れ子が、文法として出てきます
これまでも、部品の一覧を出すことはできました。ただしそれは、Excel が動いている状態で1個ずつ問い合わせて並べたものです。出てくるのは、こういう平らな表でした。
MultiPage1 L6 T49 W210 H196
ListBox1 L2 T0 W198 H186
ListBox全 L2 T0 W198 H154
3行が同じ高さに並んでいます。「ListBox1 がタブの1枚目の中にいる」ことが、この表からは分かりません。
作成マクロだと、こうなります。
' MultiPage1
Set c = dsn.Controls.Add("Forms.MultiPage.1", "MultiPage1")
c.Style = 2
Set p = c
p.Pages(0).Name = "Page1": p.Pages(0).Caption = "表示"
p.Pages(1).Name = "Page2": p.Pages(1).Caption = "全シート"
' ListBox1（表示 ページ）
Set c = p.Pages(0).Controls.Add("Forms.ListBox.1", "ListBox1")
' ListBox全（全シート ページ）
Set c = p.Pages(1).Controls.Add("Forms.ListBox.1", "ListBox全")
dsn.Controls.Add と p.Pages(0).Controls.Add は、別の文です。どちらの親に入っているかが、書き方そのものに出ています。値ではなく、関係が読める。
② 「なぜそうするか」まで入っています
さっきのページを隠してから高さを当てるところ。あれは完成した姿のどこにも存在しない情報です。できあがったフォームを眺めても、そんな順番でやったとは分かりません。
設計図には「こうなっている」しか書けません。手順書には「こうしないと作れない」が書けます。
図面を渡されるのと、作っている横で手順を見ているのとの違いだと思います。手順のほうには、図面に描かれない「順番」と「なぜ」が入っています。
③ 見た目の変更が、行として出てきます
これは今日たまたま確かめられました。このフォームのタブの文字が小さすぎて、環境によっては下がつぶれていたので、9ポイントを8ポイントに直しました。
そのあと書き出し直したら、コードの206行目と214行目がこうなっていました。
c.Font.Name = "Meiryo UI": c.Font.Size = 8
**フォームの見た目の変更が、文字として出てくる。**バイナリの時代には、原理的にできなかったことです。
なぜ、これが今まで無かったのか
作ってから調べました。フォームを VBA で作る話自体は、部品なら20年前から公開されています。
- 空のフォームを作って、ボタンを1個置くやり方（The Spreadsheet Guru / Better Solutions）
- 既存のフォームの部品を、順に読み出すやり方（MrExcel）
**読む手も、置く手も、両方あります。**なのに「読んで、置くコードを吐き出す」まで繋いだものが、私の探した範囲では見つかりませんでした。フォームを移したいという質問への答えは、たいてい「書き出して取り込めばいい」で終わります。
理由は、たぶんはっきりしています。
繋ぐ理由が無かったからです。
.frm と .frx の2つをコピーすれば、フォームは完全に移ります。劣化もしません。わざわざコードに直す必要が、どこにもない。
そして人間から見れば、フォームは読めています。デザイナで開けば、ボタンの位置も色も一目で分かる。バイナリで保存されていて困ることが、そもそも無かった。
困る相手が現れたのは、最近です。読めなくて困るのは、AI だけでした。
だからこの空白は、誰かが見落としていたというより、問題のほうが後から生まれたのだと思います。私はたまたま、AI と一緒にフォームを直す時間が長かったので、先に困っただけです。
事実と見立ての仕分け
事実。 .frm が498行で、部品の情報が OleObjectBlob の1行に畳まれていること（実物確認）。.frx が8,216バイトで、先頭に複合ファイルの目印があること（実物確認）。書き出した作成マクロが765行・35,193文字であること。手元の22本が3.4秒で組み上がったこと（私自身のテスト・1台）。フォントを9から8に直したら、書き出しの該当行が8になったこと（同日確認）。落とし穴3つは、いずれも実際に踏んで直したものです。
見立て。 「前例が見当たらない」は、私が探した範囲の話です。世界中を調べたわけではありません。「読めなくて困るのは AI だけだった」も、空白の理由についての私の説明であって、確かめようがありません。「1本目でこけた分が道具の中身になった」も、後から振り返っての整理です。
正直な線引き
- 受け取る側の Excel で、設定が1つ必要です。「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」（オプション → トラスト センター → トラスト センターの設定 → マクロの設定）。自分のコードで自分の VBA を書き換える操作なので、ここが外れていると動きません。作成マクロは、外れていればその旨を出して止まります
- **埋め込んだ画像は運べません。**書き出しの対象から外れています。絵を貼ったフォームだけは別の手当てが要ります
- **同じブックで実行すると、いま入っているフォームが作り直したものに置き換わります。**古いほうは「旧○○1」へ逃がしてから消す作りなので事故にはなりませんが、押す場所には気をつけてください
- 確かめているのは Windows 11・64bit Excel の私の一台だけです
- 大きいフォームは「〜つづき2」へ分かれます。1本目から順に呼ばれる作りなので、途中だけ実行しないでください
- この書き出しをやっている道具（VBA 管理ツール）のほうは、公開しているリポジトリにあります。ただし今回の書き出し機能は、まだそちらに反映していません
貼れば、出てきます
この記事の題材にしたフォームそのものを置いておきます。ワークシートの管理フォームです。
- 表示中のシートの一覧と、非表示も含めた全シートの一覧を、タブで切り替えます
- 全シート側には「表示／非表示／非表示(深)」の状態が出ます。ボタン1つで反転します
- 検索、追加、複写、削除、並べ替え、名前の変更、タブの色替え
「全シート」に切り替えると、右側に状態の列が出ます。
シートを選んで「表示⇔非表示」を押すと、その場で切り替わります。左上の数字も「表示 4 ／ 全 4」から「表示 3 ／ 全 4」に変わりました。
Excel の標準では、隠したシートを戻すのは1枚ずつです。深く隠したシートに至っては、そもそも一覧に出てきません。そこを埋めるための道具なので、Excel を使う人なら誰でも使い道があると思います。
なお、タブに見えている「表示」「全シート」は、本物のタブではありません。 標準のタブは選択中の色を変えられないので、タブを消して、押しボタンを2つ並べて自前のタブにしてあります。この仕掛けも、下のコードにそのまま入っています。
使い方
- 標準モジュールを1つ作って、下のコードを丸ごと貼る
- 上の設定（VBA プロジェクトへのアクセスを信頼する）を確認する
-
ワークシート一覧作成を実行する - フォームができあがります。呼び出しは次のマクロで行います
呼び出すマクロ
ワークシート一覧.Show の一行でも出ますが、実際に使っていると具合の悪いところが出てきたので、こういう形に落ち着きました。私が普段使っているものそのままです。
Sub ワークシート一覧の表示()
On Error GoTo エラー処理
If ActiveWorkbook Is Nothing Then Exit Sub
' 前に開いたものが残っていたら片付けてから開く。
' 表示前にフォームの中身を触ると Initialize が先に走り、
' 二重に読み込まれた状態と重なって Excel ごと落ちることがある。
' 一覧づくりはフォーム側の Initialize に任せ、ここでは触らない。
Unload ワークシート一覧
Load ワークシート一覧
ワークシート一覧.StartUpPosition = 0
ワークシート一覧.Top = Application.Top + ((Application.Height - ワークシート一覧.Height) / 2)
ワークシート一覧.Left = Application.Left + ((Application.Width - ワークシート一覧.Width) / 2)
ワークシート一覧.Show vbModeless
' 表示直後はExcel本体に焦点が戻る癖があるので、フォームへ渡し直す
DoEvents
On Error Resume Next
ワークシート一覧.ListBox1.SetFocus
Exit Sub
エラー処理:
Exit Sub
End Sub
短いマクロですが、4か所とも理由があります。
① 開く前に、いったん閉じます
Unload を先に撃っています。前に開いたものが中途半端に残っていると、二重に読み込まれた状態と重なって、Excel ごと落ちることがありました。
関連して、このマクロは**フォームの中身を一切触っていません。**リストを埋めるのはフォーム側の Initialize に任せています。表示する前に外から中身を触ると Initialize が先に走ってしまい、同じ落ち方をします。
② 位置は自分で計算しています
StartUpPosition = 0 にして、Excel の窓のまん中へ手で置いています。画面のまん中ではなく、Excel の窓のまん中です。Excel を右半分に寄せて使っているとき、標準のままだと変なところに出ます。
③ 表示した直後に、焦点を渡し直しています
Show した直後は、Excel 本体のほうへ焦点が戻る癖があります。そのままだと、開いた瞬間に上下キーを押してもリストが動きません。DoEvents を1回はさんでから、リストへ渡し直しています。
④ vbModeless で開いています
フォームを開いたままシートを触れます。シートを見ながら選びたい道具なので、こうしてあります。**その代わり Esc では閉じません。**すぐ閉じたい種類のフォームなら Show だけ（モーダル）のほうが向いています。
なお、このマクロには Ctrl + Shift + W を割り当てて使っています。割り当ては「開発 → マクロ → オプション」から設定できます。
そして本体のマクロです。結構長いので畳んでおります。下の横三角をポチッと押してください。
ワークシート一覧作成（765行）
Sub ワークシート一覧作成()
'★VBAだけで「ワークシート一覧」を組み立て直す（一回実行すればフォームが出来る）
Const フォーム名 As String = "ワークシート一覧"
Dim vbp As Object
Dim vbc As Object
Dim dsn As Object
Dim c As Object
Dim p As Object
Dim 既存 As Object
Dim i As Long
Dim s As String
On Error Resume Next
Set vbp = ThisWorkbook.VBProject
On Error GoTo 0
If vbp Is Nothing Then
MsgBox "Excel のオプション → トラスト センター → トラスト センターの設定 → マクロの設定 で" & vbCrLf & _
"「VBA プロジェクト オブジェクト モデルへのアクセスを信頼する」にチェックを入れてから、もう一度実行してください。", _
vbExclamation
Exit Sub
End If
' 同名のフォームがあれば、消さずに改名して逃がす。
' 削除した名前は Excel を閉じるまで VBE が握ったままで、その名前では作り直せない。
' 改名なら名前がすぐ解放されるので、この実行の中で作り直せる（最後に古い方を消す）。
On Error Resume Next
Set 既存 = vbp.VBComponents(フォーム名)
On Error GoTo 0
If Not 既存 Is Nothing Then
For i = 1 To 999
Err.Clear
On Error Resume Next
既存.Name = "旧" & フォーム名 & i
On Error GoTo 0
If Err.Number = 0 Then Exit For
Next i
If Err.Number <> 0 Then
MsgBox "古い「" & フォーム名 & "」を逃がせませんでした。" & vbCrLf & _
"VBE でそのフォームを閉じてから、もう一度実行してください。", vbExclamation
Exit Sub
End If
End If
' フォーム本体（3 = UserForm）
Set vbc = vbp.VBComponents.Add(3)
vbc.Name = フォーム名
vbc.Properties("Caption") = "ワークシート一覧"
vbc.Properties("StartUpPosition") = 1
vbc.Properties("Width") = 298.5
vbc.Properties("Height") = 312
vbc.Properties("BackColor") = &H80000003
Set dsn = vbc.Designer
' 内寸 287.5 x 283.5（元フォームと同じ）
' Label1
Set c = dsn.Controls.Add("Forms.Label.1", "Label1")
c.Left = 12: c.Top = 9: c.Width = 36: c.Height = 15
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 12: c.Top = 9: c.Width = 36: c.Height = 15
c.Caption = "検 索"
c.BackColor = &H80000003
' txtSearch
Set c = dsn.Controls.Add("Forms.TextBox.1", "txtSearch")
c.Left = 48: c.Top = 6: c.Width = 168: c.Height = 22
c.Font.Name = "MS UI Gothic": c.Font.Size = 12
c.Left = 48: c.Top = 6: c.Width = 168: c.Height = 22
' CommandButton4
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton4")
c.Left = 222: c.Top = 6: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 6: c.Width = 60: c.Height = 24
c.Caption = "次 へ"
' CommandButton5
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton5")
c.Left = 222: c.Top = 30: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 30: c.Width = 60: c.Height = 24
c.Caption = "前 へ"
' CommandButton6
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton6")
c.Left = 222: c.Top = 60: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 60: c.Width = 60: c.Height = 24
c.Caption = "確 定"
' CommandButton1
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton1")
c.Left = 222: c.Top = 90: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 90: c.Width = 60: c.Height = 24
c.Caption = "追 加"
' CommandButton2
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton2")
c.Left = 222: c.Top = 114: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 114: c.Width = 60: c.Height = 24
c.Caption = "タ ブ 色"
' MultiPage1
Set c = dsn.Controls.Add("Forms.MultiPage.1", "MultiPage1")
c.Left = 6: c.Top = 49: c.Width = 210: c.Height = 196
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 6: c.Top = 49: c.Width = 210: c.Height = 196
c.Style = 2
c.BackColor = &H80000003
Set p = c
Do While p.Pages.Count > 2
p.Pages.Remove p.Pages.Count - 1
Loop
Do While p.Pages.Count < 2
p.Pages.Add
Loop
p.Pages(0).Name = "Page1": p.Pages(0).Caption = "表示"
p.Pages(1).Name = "Page2": p.Pages(1).Caption = "全シート"
' ListBox1（表示 ページ）
Set c = p.Pages(0).Controls.Add("Forms.ListBox.1", "ListBox1")
c.Left = 2: c.Top = 0: c.Width = 198: c.Height = 186
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.IntegralHeight = False
c.Left = 2: c.Top = 0: c.Width = 198: c.Height = 186
' ListBox全（全シート ページ）
Set c = p.Pages(1).Controls.Add("Forms.ListBox.1", "ListBox全")
c.Left = 2: c.Top = 0: c.Width = 198: c.Height = 154
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.IntegralHeight = False
c.Left = 2: c.Top = 0: c.Width = 198: c.Height = 154
c.ColumnCount = 2
c.ColumnWidths = "120 pt;56 pt"
' btnToggle（全シート ページ）
Set c = p.Pages(1).Controls.Add("Forms.CommandButton.1", "btnToggle")
c.Left = 2: c.Top = 158: c.Width = 120: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 2: c.Top = 158: c.Width = 120: c.Height = 24
c.Caption = "表示⇔非表示"
' CommandButton13
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton13")
c.Left = 222: c.Top = 144: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 144: c.Width = 60: c.Height = 24
c.Caption = "コ ピ ー"
' CommandButton12
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton12")
c.Left = 222: c.Top = 168: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 168: c.Width = 60: c.Height = 24
c.Caption = "削 除"
' btnMoveUp
Set c = dsn.Controls.Add("Forms.CommandButton.1", "btnMoveUp")
c.Left = 222: c.Top = 194: c.Width = 28: c.Height = 22
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 194: c.Width = 28: c.Height = 22
c.Caption = "▲"
' btnMoveDown
Set c = dsn.Controls.Add("Forms.CommandButton.1", "btnMoveDown")
c.Left = 254: c.Top = 194: c.Width = 28: c.Height = 22
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 254: c.Top = 194: c.Width = 28: c.Height = 22
c.Caption = "▼"
' CommandButton3
Set c = dsn.Controls.Add("Forms.CommandButton.1", "CommandButton3")
c.Left = 222: c.Top = 220: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 220: c.Width = 60: c.Height = 24
c.Caption = "終 了"
c.Cancel = True
' lblRename
Set c = dsn.Controls.Add("Forms.Label.1", "lblRename")
c.Left = 6: c.Top = 252: c.Width = 66: c.Height = 18
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 6: c.Top = 252: c.Width = 66: c.Height = 18
c.Caption = "シート名："
c.BackColor = &H80000003
' txtNewName
Set c = dsn.Controls.Add("Forms.TextBox.1", "txtNewName")
c.Left = 74: c.Top = 252: c.Width = 142: c.Height = 22
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 74: c.Top = 252: c.Width = 142: c.Height = 22
' btnRename
Set c = dsn.Controls.Add("Forms.CommandButton.1", "btnRename")
c.Left = 222: c.Top = 252: c.Width = 60: c.Height = 24
c.Font.Name = "Meiryo UI": c.Font.Size = 12
c.Left = 222: c.Top = 252: c.Width = 60: c.Height = 24
c.Caption = "変 更"
' tglTab表示
Set c = dsn.Controls.Add("Forms.ToggleButton.1", "tglTab表示")
c.Left = 6: c.Top = 30: c.Width = 44: c.Height = 19
c.Font.Name = "Meiryo UI": c.Font.Size = 8
c.Left = 6: c.Top = 30: c.Width = 44: c.Height = 19
c.Caption = "表示"
c.TabStop = False
' tglTab全
Set c = dsn.Controls.Add("Forms.ToggleButton.1", "tglTab全")
c.Left = 50: c.Top = 30: c.Width = 58: c.Height = 19
c.Font.Name = "Meiryo UI": c.Font.Size = 8
c.Left = 50: c.Top = 30: c.Width = 58: c.Height = 19
c.Caption = "全シート"
c.TabStop = False
' lblシート数
Set c = dsn.Controls.Add("Forms.Label.1", "lblシート数")
c.Left = 112: c.Top = 33: c.Width = 104: c.Height = 14
c.Font.Name = "Meiryo UI": c.Font.Size = 8
c.Left = 112: c.Top = 33: c.Width = 104: c.Height = 14
c.Caption = ""
c.BackColor = &H80000003
c.TextAlign = 3
' タブ順（作った順で既に揃うが、念のため小さい方から明示する）
dsn.Controls("Label1").TabIndex = 0
dsn.Controls("txtSearch").TabIndex = 1
dsn.Controls("CommandButton4").TabIndex = 2
dsn.Controls("CommandButton5").TabIndex = 3
dsn.Controls("CommandButton6").TabIndex = 4
dsn.Controls("CommandButton1").TabIndex = 5
dsn.Controls("CommandButton2").TabIndex = 6
dsn.Controls("MultiPage1").TabIndex = 7
dsn.Controls("CommandButton13").TabIndex = 8
dsn.Controls("CommandButton12").TabIndex = 9
dsn.Controls("btnMoveUp").TabIndex = 10
dsn.Controls("btnMoveDown").TabIndex = 11
dsn.Controls("CommandButton3").TabIndex = 12
dsn.Controls("lblRename").TabIndex = 13
dsn.Controls("txtNewName").TabIndex = 14
dsn.Controls("btnRename").TabIndex = 15
dsn.Controls("tglTab表示").TabIndex = 16
dsn.Controls("tglTab全").TabIndex = 17
dsn.Controls("lblシート数").TabIndex = 18
' リストの高さ（行数の倍数への丸めを避けるため最後に当て直す）
' 表示中のページに載っているリストは当てた瞬間に丸め直される。
' そのリストのページを一度隠してから当てると、戻しても残る。
dsn.Controls("MultiPage1").Value = 1
DoEvents ' ページの切り替えを効かせてから当てる
dsn.Controls("ListBox1").Height = 186
dsn.Controls("MultiPage1").Value = 0
DoEvents ' ページの切り替えを効かせてから当てる
dsn.Controls("ListBox全").Height = 154
dsn.Controls("MultiPage1").Value = 0 ' 既定のページへ戻す
' フォームの中身
s = ""
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "Dim suppressClick As Boolean" & vbCrLf
s = s & "Dim suppressTab As Boolean" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub UserForm_Initialize()" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " Call タブ表示更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "'----------------------------------------------------------------------" & vbCrLf
s = s & "' 自前タブ（表示／全シート）：選択中だけ薄い色に変える" & vbCrLf
s = s & "'----------------------------------------------------------------------" & vbCrLf
s = s & "Private Sub tglTab表示_Click()" & vbCrLf
s = s & " If suppressTab Then Exit Sub" & vbCrLf
s = s & " MultiPage1.value = 0" & vbCrLf
s = s & " Call タブ表示更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub tglTab全_Click()" & vbCrLf
s = s & " If suppressTab Then Exit Sub" & vbCrLf
s = s & " MultiPage1.value = 1" & vbCrLf
s = s & " Call タブ表示更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub タブ表示更新()" & vbCrLf
s = s & " suppressTab = True" & vbCrLf
s = s & " tglTab表示.value = (MultiPage1.value = 0)" & vbCrLf
s = s & " tglTab全.value = (MultiPage1.value = 1)" & vbCrLf
s = s & " If MultiPage1.value = 0 Then" & vbCrLf
s = s & " tglTab表示.BackColor = RGB(221, 235, 247) ' 選択中＝淡い青" & vbCrLf
s = s & " tglTab全.BackColor = &H8000000F ' ボタン標準色" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " tglTab表示.BackColor = &H8000000F" & vbCrLf
s = s & " tglTab全.BackColor = RGB(221, 235, 247)" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " suppressTab = False" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub txtSearch_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)" & vbCrLf
s = s & " Me.txtSearch.IMEMode = fmIMEModeOn" & vbCrLf
s = s & " Me.txtSearch.SetFocus" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub txtSearch_Change()" & vbCrLf
s = s & " Dim kw As String" & vbCrLf
s = s & " kw = txtSearch.value" & vbCrLf
s = s & " ListBox1.Clear" & vbCrLf
s = s & " Dim i As Integer" & vbCrLf
s = s & " For i = 1 To Worksheets.Count" & vbCrLf
s = s & " If Worksheets(i).Name <> ""sheet1"" And Worksheets(i).Visible = xlSheetVisible Then" & vbCrLf
s = s & " If kw = """" Or InStr(1, Worksheets(i).Name, kw, vbTextCompare) > 0 Then" & vbCrLf
s = s & " ListBox1.AddItem Worksheets(i).Name" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " If ListBox1.ListCount > 0 Then" & vbCrLf
s = s & " ListBox1.Selected(0) = True" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Call 全リスト更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub CommandButton4_Click()" & vbCrLf
s = s & " ' 次へ：非表示シートは飛ばす（表示中のシートだけを順に回る）" & vbCrLf
s = s & " Dim i As Long" & vbCrLf
s = s & " Dim n As Long" & vbCrLf
s = s & " Dim idx As Long" & vbCrLf
s = s & " n = Worksheets.Count" & vbCrLf
s = s & " idx = ActiveSheet.Index" & vbCrLf
s = s & " For i = 1 To n" & vbCrLf
s = s & " idx = idx + 1" & vbCrLf
s = s & " If idx > n Then idx = 1" & vbCrLf
s = s & " If Worksheets(idx).Visible = xlSheetVisible Then" & vbCrLf
s = s & " Worksheets(idx).Select" & vbCrLf
s = s & " Exit For" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub CommandButton5_Click()" & vbCrLf
s = s & " ' 前へ：非表示シートは飛ばす（表示中のシートだけを順に回る）" & vbCrLf
s = s & " Dim i As Long" & vbCrLf
s = s & " Dim n As Long" & vbCrLf
s = s & " Dim idx As Long" & vbCrLf
s = s & " n = Worksheets.Count" & vbCrLf
s = s & " idx = ActiveSheet.Index" & vbCrLf
s = s & " For i = 1 To n" & vbCrLf
s = s & " idx = idx - 1" & vbCrLf
s = s & " If idx < 1 Then idx = n" & vbCrLf
s = s & " If Worksheets(idx).Visible = xlSheetVisible Then" & vbCrLf
s = s & " Worksheets(idx).Select" & vbCrLf
s = s & " Exit For" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub CommandButton6_Click()" & vbCrLf
s = s & " Unload Me" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "Private Sub CommandButton1_Click()" & vbCrLf
s = s & " Application.ScreenUpdating = False" & vbCrLf
s = s & " Worksheets.Add After:=ActiveSheet" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " Application.ScreenUpdating = True" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "Private Sub CommandButton2_Click()" & vbCrLf
s = s & " Dim shName As String" & vbCrLf
s = s & " If MultiPage1.value = 1 Then" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " shName = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " shName = ListBox1.text" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If shName = """" Then Exit Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & " Dim sh As Worksheet" & vbCrLf
s = s & " Set sh = Sheets(shName)" & vbCrLf
s = s & "" & vbCrLf
s = s & " Dim curIdx As Integer" & vbCrLf
s = s & " curIdx = タブ色現在インデックス(sh)" & vbCrLf
s = s & "" & vbCrLf
s = s & " Dim nextIdx As Integer" & vbCrLf
s = s & " nextIdx = (curIdx + 1) Mod 7 ' 0=橙,1=黄,2=赤,3=緑,4=青,5=紫,6=白(色なし)" & vbCrLf
s = s & "" & vbCrLf
s = s & " Application.ScreenUpdating = False" & vbCrLf
s = s & " タブ色設定 sh, nextIdx" & vbCrLf
s = s & " Application.ScreenUpdating = True" & vbCrLf
s = s & "" & vbCrLf
s = s & " タブ色ボタン更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub CommandButton12_Click()" & vbCrLf
s = s & " Dim AAAAA As String" & vbCrLf
s = s & " If MultiPage1.value = 1 Then" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " AAAAA = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " AAAAA = ListBox1.value" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If AAAAA = """" Then Exit Sub" & vbCrLf
s = s & " Application.ScreenUpdating = False" & vbCrLf
s = s & " Application.DisplayAlerts = False" & vbCrLf
s = s & " On Error Resume Next" & vbCrLf
s = s & " Worksheets(AAAAA).Delete" & vbCrLf
s = s & " On Error GoTo 0" & vbCrLf
s = s & " Application.DisplayAlerts = True" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " Application.ScreenUpdating = True" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub CommandButton3_Click()" & vbCrLf
s = s & " Unload Me" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "Private Sub ListBox1_Click()" & vbCrLf
s = s & " If suppressClick Then Exit Sub" & vbCrLf
s = s & " Dim BBBB As String" & vbCrLf
s = s & " BBBB = ListBox1.text" & vbCrLf
s = s & " If BBBB <> """" Then" & vbCrLf
s = s & " On Error Resume Next ' 一覧が古い場合の消えた名前ガード" & vbCrLf
s = s & " Sheets(BBBB).Select" & vbCrLf
s = s & " On Error GoTo 0" & vbCrLf
s = s & " txtNewName.value = BBBB" & vbCrLf
s = s & " タブ色ボタン更新" & vbCrLf
s = s & " End If" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)" & vbCrLf
s = s & " Dim BBBB As String" & vbCrLf
s = s & " BBBB = ListBox1.text" & vbCrLf
s = s & " If BBBB <> """" Then Sheets(BBBB).Select" & vbCrLf
s = s & " Unload Me" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "Private Sub リスト更新()" & vbCrLf
s = s & " suppressClick = True" & vbCrLf
s = s & " Dim kw As String" & vbCrLf
s = s & " kw = txtSearch.value" & vbCrLf
s = s & " ListBox1.Clear" & vbCrLf
s = s & " Dim i As Integer, idx As Long" & vbCrLf
s = s & " idx = -1" & vbCrLf
s = s & " For i = 1 To Worksheets.Count" & vbCrLf
s = s & " If Worksheets(i).Name <> ""sheet1"" And Worksheets(i).Visible = xlSheetVisible Then" & vbCrLf
s = s & " If kw = """" Or InStr(1, Worksheets(i).Name, kw, vbTextCompare) > 0 Then" & vbCrLf
s = s & " ListBox1.AddItem Worksheets(i).Name" & vbCrLf
s = s & " If Worksheets(i).Name = ActiveSheet.Name Then idx = ListBox1.ListCount - 1" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " If idx >= 0 Then" & vbCrLf
s = s & " ListBox1.Selected(idx) = True" & vbCrLf
s = s & " ElseIf ListBox1.ListCount > 0 Then" & vbCrLf
s = s & " ListBox1.Selected(0) = True" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If MultiPage1.value = 0 Then ListBox1.SetFocus" & vbCrLf
s = s & " suppressClick = False" & vbCrLf
s = s & " Call 全リスト更新 ' 先に全シート側を更新（消えた名前の選択を残さない）" & vbCrLf
s = s & " ' シート名欄は「いま見えているタブの選択」に合わせる" & vbCrLf
s = s & " If MultiPage1.value = 1 And ListBox全.ListIndex >= 0 Then" & vbCrLf
s = s & " txtNewName.value = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " ElseIf ListBox1.text <> """" Then" & vbCrLf
s = s & " txtNewName.value = ListBox1.text" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " タブ色ボタン更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "'----------------------------------------------------------------------" & vbCrLf
s = s & "' 全シートタブ：非表示も含めた全シートと状態の一覧" & vbCrLf
s = s & "'----------------------------------------------------------------------" & vbCrLf
s = s & "Private Sub 全リスト更新()" & vbCrLf
s = s & " Dim i As Integer" & vbCrLf
s = s & " Dim kw As String" & vbCrLf
s = s & " Dim 前選択 As String" & vbCrLf
s = s & " Dim idx As Long" & vbCrLf
s = s & " Dim 表示数 As Long" & vbCrLf
s = s & " If ListBox全.ListIndex >= 0 Then 前選択 = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " If 前選択 = """" Then 前選択 = ActiveSheet.Name ' 初回はアクティブシートを選ぶ" & vbCrLf
s = s & " kw = txtSearch.value" & vbCrLf
s = s & " ListBox全.Clear" & vbCrLf
s = s & " idx = -1" & vbCrLf
s = s & " For i = 1 To Worksheets.Count" & vbCrLf
s = s & " If kw = """" Or InStr(1, Worksheets(i).Name, kw, vbTextCompare) > 0 Then" & vbCrLf
s = s & " ListBox全.AddItem Worksheets(i).Name" & vbCrLf
s = s & " Select Case Worksheets(i).Visible" & vbCrLf
s = s & " Case xlSheetVisible: ListBox全.List(ListBox全.ListCount - 1, 1) = ""表示""" & vbCrLf
s = s & " Case xlSheetHidden: ListBox全.List(ListBox全.ListCount - 1, 1) = ""非表示""" & vbCrLf
s = s & " Case xlSheetVeryHidden: ListBox全.List(ListBox全.ListCount - 1, 1) = ""非表示(深)""" & vbCrLf
s = s & " End Select" & vbCrLf
s = s & " If Worksheets(i).Name = 前選択 Then idx = ListBox全.ListCount - 1" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " If idx < 0 Then" & vbCrLf
s = s & " ' 前の選択が消えていたらアクティブシートの行へ（それも無ければ先頭）" & vbCrLf
s = s & " For i = 0 To ListBox全.ListCount - 1" & vbCrLf
s = s & " If ListBox全.List(i, 0) = ActiveSheet.Name Then idx = i: Exit For" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If idx >= 0 Then" & vbCrLf
s = s & " ListBox全.Selected(idx) = True" & vbCrLf
s = s & " ElseIf ListBox全.ListCount > 0 Then" & vbCrLf
s = s & " ListBox全.Selected(0) = True" & vbCrLf
s = s & " End If" & vbCrLf
s = s & "" & vbCrLf
s = s & " ' タブ右の空きにシート数（ブック全体の数。検索の絞り込みでは変わらない）" & vbCrLf
s = s & " 表示数 = 0" & vbCrLf
s = s & " For i = 1 To Worksheets.Count" & vbCrLf
s = s & " If Worksheets(i).Visible = xlSheetVisible Then 表示数 = 表示数 + 1" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " lblシート数.Caption = ""表示 "" & 表示数 & "" ／ 全 "" & Worksheets.Count" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "' 全シートタブで選んだら、シート名欄とタブ色表示も追随させる" & vbCrLf
s = s & "' （右列のボタンは「いま見えているタブの選択」に効く）" & vbCrLf
s = s & "Private Sub ListBox全_Click()" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " txtNewName.value = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " タブ色ボタン更新" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "'----------------------------------------------------------------------" & vbCrLf
s = s & "' [表示⇔非表示] 全シートタブで選んだシートの表示状態を反転する" & vbCrLf
s = s & "'----------------------------------------------------------------------" & vbCrLf
s = s & "Private Sub btnToggle_Click()" & vbCrLf
s = s & " Dim shName As String" & vbCrLf
s = s & " Dim sh As Worksheet" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " shName = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Set sh = Worksheets(shName)" & vbCrLf
s = s & " On Error GoTo ErrHandler" & vbCrLf
s = s & " If sh.Visible = xlSheetVisible Then" & vbCrLf
s = s & " sh.Visible = xlSheetHidden" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " sh.Visible = xlSheetVisible" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " Exit Sub" & vbCrLf
s = s & "ErrHandler:" & vbCrLf
s = s & " MsgBox ""切り替えられませんでした："" & Err.Description & vbCrLf & _" & vbCrLf
s = s & " ""（表示シートが残り1枚のときは非表示にできません）"", vbExclamation" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub btnRename_Click()" & vbCrLf
s = s & " Dim oldName As String" & vbCrLf
s = s & " Dim newName As String" & vbCrLf
s = s & " If MultiPage1.value = 1 Then" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " oldName = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " oldName = ListBox1.text" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " newName = Trim(txtNewName.value)" & vbCrLf
s = s & " If oldName = """" Or newName = """" Then Exit Sub" & vbCrLf
s = s & " If oldName = newName Then Exit Sub" & vbCrLf
s = s & " On Error GoTo ErrHandler" & vbCrLf
s = s & " Sheets(oldName).Name = newName" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " ' 全シートタブ中は改名後の名前を選び直す（表示タブはアクティブシート追随で足りる）" & vbCrLf
s = s & " If MultiPage1.value = 1 Then" & vbCrLf
s = s & " Dim i As Long" & vbCrLf
s = s & " For i = 0 To ListBox全.ListCount - 1" & vbCrLf
s = s & " If ListBox全.List(i, 0) = newName Then" & vbCrLf
s = s & " ListBox全.Selected(i) = True" & vbCrLf
s = s & " txtNewName.value = newName" & vbCrLf
s = s & " Exit For" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Exit Sub" & vbCrLf
s = s & "ErrHandler:" & vbCrLf
s = s & " MsgBox ""シート名の変更に失敗しました。"" & vbCrLf & _" & vbCrLf
s = s & " ""使用できない文字が含まれるか、同名のシートが既に存在します。"", vbExclamation" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub CommandButton13_Click()" & vbCrLf
s = s & " Dim shName As String" & vbCrLf
s = s & " If MultiPage1.value = 1 Then" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " shName = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " shName = ListBox1.text" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If shName = """" Then Exit Sub" & vbCrLf
s = s & " On Error GoTo ErrHandler" & vbCrLf
s = s & " Sheets(shName).Copy After:=Sheets(shName)" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " Exit Sub" & vbCrLf
s = s & "ErrHandler:" & vbCrLf
s = s & " MsgBox ""シートのコピーに失敗しました。"", vbExclamation" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub btnMoveUp_Click()" & vbCrLf
s = s & " Dim shName As String" & vbCrLf
s = s & " If MultiPage1.value = 1 Then" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " shName = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " shName = ListBox1.text" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If shName = """" Then Exit Sub" & vbCrLf
s = s & " Dim idx As Integer" & vbCrLf
s = s & " idx = Sheets(shName).Index" & vbCrLf
s = s & " If idx <= 1 Then Exit Sub" & vbCrLf
s = s & " On Error GoTo ErrHandler" & vbCrLf
s = s & " Sheets(shName).Move Before:=Worksheets(idx - 1)" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " Exit Sub" & vbCrLf
s = s & "ErrHandler:" & vbCrLf
s = s & " MsgBox ""シートの移動に失敗しました。"", vbExclamation" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub btnMoveDown_Click()" & vbCrLf
s = s & " Dim shName As String" & vbCrLf
s = s & " If MultiPage1.value = 1 Then" & vbCrLf
s = s & " If ListBox全.ListIndex < 0 Then Exit Sub" & vbCrLf
s = s & " shName = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " shName = ListBox1.text" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If shName = """" Then Exit Sub" & vbCrLf
s = s & " Dim idx As Integer" & vbCrLf
s = s & " idx = Sheets(shName).Index" & vbCrLf
s = s & " If idx >= Worksheets.Count Then Exit Sub" & vbCrLf
s = s & " On Error GoTo ErrHandler" & vbCrLf
s = s & " Sheets(shName).Move After:=Worksheets(idx + 1)" & vbCrLf
s = s & " Call リスト更新" & vbCrLf
s = s & " Exit Sub" & vbCrLf
s = s & "ErrHandler:" & vbCrLf
s = s & " MsgBox ""シートの移動に失敗しました。"", vbExclamation" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub ListMove(ByVal delta As Integer)" & vbCrLf
s = s & " If ListBox1.ListCount = 0 Then Exit Sub" & vbCrLf
s = s & " Dim cur As Long, nxt As Long, i As Long" & vbCrLf
s = s & " cur = ListBox1.ListIndex" & vbCrLf
s = s & " If cur < 0 Then cur = 0" & vbCrLf
s = s & " nxt = cur + delta" & vbCrLf
s = s & " If nxt >= ListBox1.ListCount Then nxt = 0" & vbCrLf
s = s & " If nxt < 0 Then nxt = ListBox1.ListCount - 1" & vbCrLf
s = s & " For i = 0 To ListBox1.ListCount - 1" & vbCrLf
s = s & " ListBox1.Selected(i) = (i = nxt)" & vbCrLf
s = s & " Next i" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub ListConfirm()" & vbCrLf
s = s & " Dim sName As String" & vbCrLf
s = s & " sName = ListBox1.text" & vbCrLf
s = s & " On Error Resume Next ' 消えた名前ガード" & vbCrLf
s = s & " If sName <> """" Then Sheets(sName).Select" & vbCrLf
s = s & " On Error GoTo 0" & vbCrLf
s = s & " Unload Me" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)" & vbCrLf
s = s & " Select Case KeyCode" & vbCrLf
s = s & " Case vbKeyDown" & vbCrLf
s = s & " ListMove 1" & vbCrLf
s = s & " KeyCode = 0" & vbCrLf
s = s & " Case vbKeyUp" & vbCrLf
s = s & " ListMove -1" & vbCrLf
s = s & " KeyCode = 0" & vbCrLf
s = s & " Case vbKeyReturn" & vbCrLf
s = s & " ListConfirm" & vbCrLf
s = s & " KeyCode = 0" & vbCrLf
s = s & " End Select" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub txtSearch_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)" & vbCrLf
s = s & " Select Case KeyCode" & vbCrLf
s = s & " Case vbKeyDown" & vbCrLf
s = s & " ListMove 1" & vbCrLf
s = s & " KeyCode = 0" & vbCrLf
s = s & " Case vbKeyUp" & vbCrLf
s = s & " ListMove -1" & vbCrLf
s = s & " KeyCode = 0" & vbCrLf
s = s & " Case vbKeyReturn" & vbCrLf
s = s & " ListConfirm" & vbCrLf
s = s & " KeyCode = 0" & vbCrLf
s = s & " End Select" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Function タブ色現在インデックス(sh As Worksheet) As Integer" & vbCrLf
s = s & " ' 戻り値: 0=橙, 1=黄, 2=赤, 3=緑, 4=青, 5=紫, 6=白(色なし)" & vbCrLf
s = s & " ' 一覧外の色は -1 を返す（呼び出し側で +1 → 0 = 橙 になる）" & vbCrLf
s = s & " If sh.Tab.ColorIndex = xlColorIndexNone Then" & vbCrLf
s = s & " タブ色現在インデックス = 6" & vbCrLf
s = s & " Exit Function" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " Select Case sh.Tab.Color" & vbCrLf
s = s & " Case RGB(237, 125, 49): タブ色現在インデックス = 0 ' 橙" & vbCrLf
s = s & " Case RGB(255, 192, 0): タブ色現在インデックス = 1 ' 黄" & vbCrLf
s = s & " Case RGB(192, 0, 0): タブ色現在インデックス = 2 ' 赤" & vbCrLf
s = s & " Case RGB(112, 173, 71): タブ色現在インデックス = 3 ' 緑" & vbCrLf
s = s & " Case RGB(68, 114, 196): タブ色現在インデックス = 4 ' 青" & vbCrLf
s = s & " Case RGB(112, 48, 160): タブ色現在インデックス = 5 ' 紫" & vbCrLf
s = s & " Case Else: タブ色現在インデックス = -1 ' 一覧外" & vbCrLf
s = s & " End Select" & vbCrLf
s = s & "End Function" & vbCrLf
s = s & "" & vbCrLf
s = s & "Private Sub タブ色設定(sh As Worksheet, idx As Integer)" & vbCrLf
s = s & " Select Case idx" & vbCrLf
s = s & " Case 0: sh.Tab.Color = RGB(237, 125, 49) ' 橙" & vbCrLf
s = s & " Case 1: sh.Tab.Color = RGB(255, 192, 0) ' 黄" & vbCrLf
s = s & " Case 2: sh.Tab.Color = RGB(192, 0, 0) ' 赤" & vbCrLf
s = s & " Case 3: sh.Tab.Color = RGB(112, 173, 71) ' 緑" & vbCrLf
s = s & " Case 4: sh.Tab.Color = RGB(68, 114, 196) ' 青" & vbCrLf
s = s & " Case 5: sh.Tab.Color = RGB(112, 48, 160) ' 紫" & vbCrLf
s = s & " Case 6: sh.Tab.ColorIndex = xlColorIndexNone ' 白(色なし)" & vbCrLf
s = s & " End Select" & vbCrLf
s = s & "End Sub" & vbCrLf
s = s & "Private Sub タブ色ボタン更新()" & vbCrLf
s = s & " Dim shName As String" & vbCrLf
s = s & " If MultiPage1.value = 1 And ListBox全.ListIndex >= 0 Then" & vbCrLf
s = s & " shName = ListBox全.List(ListBox全.ListIndex, 0)" & vbCrLf
s = s & " Else" & vbCrLf
s = s & " shName = ListBox1.text" & vbCrLf
s = s & " End If" & vbCrLf
s = s & " If shName = """" Then" & vbCrLf
s = s & " CommandButton2.Caption = ""タ ブ 色""" & vbCrLf
s = s & " Exit Sub" & vbCrLf
s = s & " End If" & vbCrLf
s = s & "" & vbCrLf
s = s & " Dim idx As Integer" & vbCrLf
s = s & " On Error GoTo 無効な名前 ' 消えた/古い名前で Sheets() を引いても落とさない" & vbCrLf
s = s & " idx = タブ色現在インデックス(Sheets(shName))" & vbCrLf
s = s & " On Error GoTo 0" & vbCrLf
s = s & "" & vbCrLf
s = s & " Dim label As String" & vbCrLf
s = s & " Select Case idx" & vbCrLf
s = s & " Case 0: label = ""橙""" & vbCrLf
s = s & " Case 1: label = ""黄""" & vbCrLf
s = s & " Case 2: label = ""赤""" & vbCrLf
s = s & " Case 3: label = ""緑""" & vbCrLf
s = s & " Case 4: label = ""青""" & vbCrLf
s = s & " Case 5: label = ""紫""" & vbCrLf
s = s & " Case 6: label = ""色""" & vbCrLf
s = s & " Case Else: label = ""色""" & vbCrLf
s = s & " End Select" & vbCrLf
s = s & " CommandButton2.Caption = ""タ ブ "" & label" & vbCrLf
s = s & " Exit Sub" & vbCrLf
s = s & "" & vbCrLf
s = s & "無効な名前:" & vbCrLf
s = s & " CommandButton2.Caption = ""タ ブ 色""" & vbCrLf
s = s & "End Sub"
' 末尾に追記する（AddFromString は宣言部の直後へ差し込むので分割注入に使えない）
' 継ぎ目に余分な空行が残るので、追記の前に末尾の空行を落とす
With vbc.CodeModule
Do While .CountOfLines > 0
If Len(Trim(.Lines(.CountOfLines, 1))) > 0 Then Exit Do
.DeleteLines .CountOfLines
Loop
.InsertLines .CountOfLines + 1, s
End With
' 逃がしておいた古いフォームを片付ける（新しい方が出来上がってから）
If Not 既存 Is Nothing Then vbp.VBComponents.Remove 既存
End Sub
おわりに
やったことを一行にすると、こうなります。
設計図が読めなかったので、読むのをあきらめて、組み立て手順書を書いた。
.frx の中身を解析する道もあったはずです。8,216バイトを解いて、部品の座標を取り出す。技術のある人ならできると思います。でも、そちらへは行きませんでした。
行かずに済んだのは、欲しかったものが「図面を読むこと」ではなく「同じものをもう一度作ること」だったからです。目的が作り直しなら、図面を解くより手順を書くほうが短い。しかも手順書は、実行すれば正しいかどうかが自分で分かります。図面の解読は、合っているかを別に確かめないといけません。
そして手順書にしたら、**読めるようになったのはついででした。**読ませるつもりで始めていたら、たぶん遠回りしていたと思います。
設計図は、読まずに済みました。