HOME > エクセルVBA > サンプル > ListBox

ListBox


【ファイル名】ListBox.xlsm
【バージョン】Ver 1.0.0.1
【作成日】2019年05月27日
【更新日】2019年05月28日
【動作確認】Windows 10
【必要なソフト】Microsoft Excel 2010
【ダウンロード】ListBox.zip
【説明】フォームのListBoxのサンプルです。

フォーム

customUI14.xml
<?xml version="1.0" encoding="utf-8"?>
<customUI xmlns="http://schemas.microsoft.com/office/2006/01/customui" onLoad="onLoad">
  <ribbon startFromScratch="false">
    <tabs>
      <tab id="Tab1" label="サンプル" insertBeforeMso="TabHome" keytip="S">
        <group id="Group1" label="ListBox">
          <button id="ShowFormButton" label="フォームを表示" keytip="S" supertip="ListBoxのサンプルのフォームを表示します。" onAction="onAction" />
        </group>
      </tab>
    </tabs>
  </ribbon>
</customUI>
このページの上

UserForm1
Option Explicit

Private Sub AddButton_Click() ' 入力した文字列をリストの選択した項目の下に追加します。
  If TextBox1.TextLength < 1 Then
    MsgBox Prompt:="文字列を入力してください。", Buttons:=vbExclamation, Title:="警告"
    TextBox1.SetFocus
    Exit Sub
  End If
  
  With ListBox1
    If .ListIndex < 0 Then ' 選択していない場合は、
      .AddItem TextBox1.Text ' 最後に追加する
      .ListIndex = .ListCount - 1
    Else
      If .ListIndex = (.ListCount - 1) Then ' 最後を選択している場合は
        .AddItem TextBox1.Text ' 最後に追加する
      Else
        .AddItem TextBox1.Text, .ListIndex + 1 ' 選択している項目の下に追加する
      End If
      .ListIndex = .ListIndex + 1
    End If
  End With
  
  With TextBox1
    .Text = ""
    .SetFocus
  End With
End Sub

Private Sub BottomButton_Click() ' 選択したリストの項目を、最後に移動します。
  Dim Text As String
  
  With ListBox1
    If .ListIndex < 0 Then Exit Sub ' リストの項目を選択していない場合は、移動しない
    If .ListIndex = (.ListCount - 1) Then Exit Sub ' リストの最後の項目を選択している場合は、移動しない
    
    Text = .Text
    .RemoveItem .ListIndex
    .AddItem Text
    .ListIndex = .ListCount - 1
  End With
End Sub

Private Sub ClearButton_Click() ' リストのすべての項目を削除します。
  With ListBox1
    If .ListCount < 1 Then Exit Sub
    If MsgBox(Prompt:="元に戻せませんが、すべての項目を削除しますか?", Buttons:=vbQuestion + vbYesNo, Title:="確認") <> vbYes Then Exit Sub
    .Clear
  End With
  
  With TextBox1
    .Text = ""
    .SetFocus
  End With
End Sub

Private Sub CountButton_Click() ' リストの選択した項目のインデックスと項目数を表示します。
  Dim Msg As String
  
  With ListBox1
    Msg = "ListIndex:" & .ListIndex & vbNewLine & vbNewLine & "Text:" & .Text & vbNewLine & vbNewLine & "ListCount:" & .ListCount
  End With
  MsgBox Prompt:=Msg, Buttons:=vbInformation, Title:="情報"
End Sub

Private Sub DownButton_Click() ' 選択した項目を1つ下に移動します。
  Dim Text As String
  
  With ListBox1
    If .ListIndex < 0 Then Exit Sub ' リストの項目を選択していない場合は、移動しない
    If .ListIndex = .ListCount - 1 Then Exit Sub ' 最後の項目は移動できない
    Text = .Text
    .List(.ListIndex) = .List(.ListIndex + 1)
    .List(.ListIndex + 1) = Text
    .ListIndex = .ListIndex + 1
  End With
End Sub

Private Sub InsertButton_Click() ' 入力した文字列をリストの選択した項目の上に挿入します。
  If TextBox1.TextLength < 1 Then
    MsgBox Prompt:="文字列を入力してください。", Buttons:=vbExclamation, Title:="警告"
    TextBox1.SetFocus
    Exit Sub
  End If
  
  With ListBox1
    If .ListIndex = -1 Then ' 選択していない場合は、
      .AddItem TextBox1.Text, 0 ' 最初に挿入する(ListCountが0でもOK)
      .ListIndex = 0
    Else
      .AddItem TextBox1.Text, .ListIndex ' 選択している項目の上に挿入する
      .ListIndex = .ListIndex - 1
    End If
  End With
  
  With TextBox1
    .Text = ""
    .SetFocus
  End With
End Sub

Private Sub ListToText() ' 選択した項目の文字列をテキストボックスに代入します。
  With ListBox1
    If .ListIndex < 0 Then Exit Sub
    TextBox1.Text = .Text
  End With
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) ' ListBoxでダブルクリックの処理
  Call ListToText
End Sub

Private Sub ListBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ' リストでキーを押した場合の処理
  Const fmCtrlMask = 2 ' Ctrlキー
  
  If KeyCode = vbKeyReturn Then Call ListToText ' 選択した項目の文字列をテキストボックスに代入します。
  If KeyCode = vbKeyDelete Then RemoveButton_Click ' 選択した項目を削除します。
  
  If (Shift And fmCtrlMask) = fmCtrlMask Then ' Ctrlキーを押している場合は、
    KeyCode = 0
    If KeyCode = vbKeyUp Then
      UpButton_Click ' 選択した項目を1つ上に移動します。
    ElseIf KeyCode = vbKeyDown Then
      DownButton_Click '選択した項目を1つ下に移動します。
    ElseIf KeyCode = vbKeyHome Then
      TopButton_Click ' 選択したリストの項目を、最初に移動します。
    ElseIf KeyCode = vbKeyEnd Then
      BottomButton_Click ' 選択したリストの項目を、最後に移動します。
    End If
  End If
End Sub

Private Sub RemoveButton_Click() ' 選択した項目を削除します。
  With ListBox1
    If .ListCount < 1 Then Exit Sub
    If .ListIndex < 0 Then
      MsgBox Prompt:="削除する項目を選択してください。", Buttons:=vbExclamation, Title:="警告"
      Exit Sub
    End If
    
    .RemoveItem .ListIndex
  End With
End Sub

Private Sub TextBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) ' テキストボックスでキーを押した場合の処理
  If KeyCode = vbKeyReturn Then
    KeyCode = 0
    AddButton_Click ' 入力した文字列をリストの選択した項目の下に追加します。
  End If
End Sub

Private Sub TopButton_Click() ' 選択したリストの項目を、最初に移動します。
  Dim Text As String
  
  With ListBox1
    If .ListIndex < 1 Then Exit Sub ' 選択していないか、あるいはリストの最初の項目を選択している場合は、移動しない
    Text = .Text
    .RemoveItem .ListIndex
    .AddItem Text, 0
    .ListIndex = 0
  End With
End Sub

Private Sub UpButton_Click() ' 選択した項目を1つ上に移動します。
  Dim Text As String
  
  With ListBox1
    If .ListIndex < 1 Then Exit Sub ' リストの項目を選択していない場合と、最初の項目は移動できない
    Text = .Text
    .List(.ListIndex) = .List(.ListIndex - 1)
    .List(.ListIndex - 1) = Text
    .ListIndex = .ListIndex - 1
  End With
End Sub

Private Sub UpdateButton_Click() ' 選択したリストの項目を、入力した文字列に変更します。
  If ListBox1.ListCount < 1 Then
    MsgBox Prompt:="リストの項目がありません。", Buttons:=vbExclamation, Title:="警告"
    Exit Sub
  End If

  If ListBox1.ListIndex < 0 Then
    MsgBox Prompt:="リストの項目を選択してください。", Buttons:=vbExclamation, Title:="警告"
    Exit Sub
  End If

  If TextBox1.TextLength < 1 Then
    MsgBox Prompt:="文字列を入力してください。", Buttons:=vbExclamation, Title:="警告"
    TextBox1.SetFocus
    Exit Sub
  End If
  
  ListBox1.List(ListBox1.ListIndex) = TextBox1.Text
  
  With TextBox1
    .Text = ""
    .SetFocus
  End With
End Sub

Private Sub UserForm_Initialize() ' 初期化処理
  Dim i As Long
  
  With ListBox1
    For i = 1 To 5
      .AddItem "Item_" & Format(i, "000")
    Next
  End With
End Sub
このページの上

Module1
Option Explicit

Private rbRibbonUI As IRibbonUI   ' リボン

Sub onLoad(ribbon As IRibbonUI) ' リボンの初期処理
  Set rbRibbonUI = ribbon ' リボンの表示を更新できるようにするためにリボンをセットする
  rbRibbonUI.Invalidate ' リボンの表示を更新します。
End Sub

Sub onAction(control As IRibbonControl) ' 各メニューの処理
  On Error GoTo ErrorHandler ' エラー処理ルーチン
  Select Case control.ID
    Case "ShowFormButton"
      UserForm1.Show vbModal
    Case Else
      Beep ' 警告音
      MsgBox Prompt:=control.ID & "の処理がありません!", Buttons:=vbCritical + vbSystemModal, Title:="エラー"
      Exit Sub
  End Select
  Exit Sub
'-------------------------------------------------------------------------------------------------------------------------
ErrorHandler: ' エラー処理ルーチン
  Beep ' 警告音
  MsgBox Prompt:="エラー番号:" & Err.Number & vbCrLf & Err.Description, Buttons:=vbCritical + vbSystemModal, Title:="エラー"
End Sub
このページの上