Excelのこととか色々

Excel のこととか楽天とか いろいろ書いてみます・・・

【Excel/VBAのこと15】ツールをつくる(シートの選択ツール 少し改良)

【Excel/VBA のこと 15】

   f:id:tuna-kichi:20200223230814p:plain

 

 

 

 

前回【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

 

 

リボン登録についてはこちら
www.tuna-kichi.com

 

 

_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/