【Excel/VBA のこと 15】
前回【Excel/VBAのこと14】 で作成した シート選択ツールは
必要最低限の素材で作成しました。
シート名を一覧化して、選択したシート名のシートに飛ぶ
部品は、リストボックス、シートに移動するボタン、閉じるボタン だけです。
これだけだと、まだちょっと不便です。
改良できるところは、
1.シート名を絞り込む
2.リストボックスからダブルクリックで目的のシートに飛ぶ
です。
外観
追加した部品は、
・チェックボックス
・オプションボタン x 3
です。
私の良く使用する Excel は仕様書で、
多いもので、シート数が30枚程度あります。
シート名は規則性があり、キーワードになる文字列が使用されています。
なので、
・キーワードをオプションボタンで選択する
・キーワードを含んだシート名のみをリストボックスに表示させる
・リストボックスからダブルクリックで目的のシートに移動する
ように改良します。
プロパティ
前回と重複するところもありますが、全部載せておきます。
文字サイズや色、もちろんオブジェクト名もご自由に。
ツール起動時、オプションボタンは 使用不可にしておきます。
(フォームイニシャライズに記述することもできます)
マクロ
チェックボックス
Private Sub chSpec_Click()
If chSpec = True Then ’チェックが入ったら、
opAA.Enabled = True 'オプションボタンを使用可にする
opAB.Enabled = True
opAC.Enabled = True
Else
opAA.Enabled = False 'チェックが外れたら、
opAB.Enabled = False 'オプションボタンを使用不可にする
opAC.Enabled = False
opAA = False 'オプションボタンの値をクリアする
opAB = False
opAC = False
lstSheetName.Clear 'リストボックスの中身をクリアする
Call UserForm_Initialize 'フォームを初期化する
End If
End Sub
閉じるボタン
Private Sub cmdClose_Click()
End
End Sub
シートに移動ボタン
Private Sub cmdGo_Click()
Dim SN As String
SN = lstSheetName.Text
Sheets(SN).Select
End Sub
リストボックスをダブルクリックでシートに移動
VBEでフォーム上のリストボックスをダブルクリックして、
右側のドロップダウンリストから「DblClick」を選択すると、
そこに記述したマクロは、ダブルクリックをした時の処理になります。
Private Sub lstSheetName_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim SN As String
SN = lstSheetName.Text
Sheets(SN).Select
End Sub
オプションボタン AA
Private Sub opAA_Click()
Dim ShCnt As Long
Dim i As Long
lstSheetName.Clear 'リストボックスの中身を一度クリア
ShCnt = Sheets.Count 'シートの枚数を数える
For i = 1 To ShCnt
’シート名に「AA」が含まれていたらリストボックスに追加
If InStr(Sheets(i).Name, "AA") > 0 Then
lstSheetName.AddItem Sheets(i).Name
End If
Next i
End Sub
オプションボタン AB
Private Sub opAB_Click()
Dim ShCnt As Long
Dim i As Long
lstSheetName.Clear
ShCnt = Sheets.Count
For i = 1 To ShCnt
If InStr(Sheets(i).Name, "AB") > 0 Then
lstSheetName.AddItem Sheets(i).Name
End If
Next i
End Sub
オプションボタン AC
Private Sub opAC_Click()
Dim ShCnt As Long
Dim i As Long
lstSheetName.Clear
ShCnt = Sheets.Count
For i = 1 To ShCnt
If InStr(Sheets(i).Name, "AC") > 0 Then
lstSheetName.AddItem Sheets(i).Name
End If
Next i
End Sub
イニシャライズ(ツール初期化)
Private Sub UserForm_Initialize()
Dim ShName As String
Dim ShCnt As String
Dim i As Long
ShCnt = Sheets.Count
For i = 1 To ShCnt
lstSheetName.AddItem Sheets(i).Name
Next i
End Sub
個人用マクロブックについてはこちら
リボン登録についてはこちら
www.tuna-kichi.com
_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/