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

InsertList


【ファイル名】InsertList.xlam
【バージョン】Ver 1.0.0
【作成日】2015年02月28日
【動作確認】Windows 7
【必要なソフト】Microsoft Excel 2010
【ダウンロード】InsertList.zip
【説明】Visual Basic Editorのツールバーに文字列をカーソル行に挿入するCommandBarComboBoxのサンプルです。
【注意】実行するにはオプションの「VBA プロジェクト オブジェクト モデルへのアクセルを信頼する」にチェックを入れます。詳細はVBProjectを参照してください。

CommandBarComboBoxはマイクロソフトのサイトのCommandBarComboBox オブジェクト (Office)を参照してください。
コンボボックスで[Enter]キーを押すか、リストを選択すると文字列をカーソル行に挿入します。
右クリックしたメニューから選択した行のテキストをリストに追加します。
コンボボックスのリストに存在しない文字列を入力して[Enter]キーを押すとリストに追加されます。

文字列を挿入するコンボボックスは同じフォルダにある「InsertList.txt」ファイルを読み書きします。テキストエディタで編集する場合はエクセルを終了してください。

InsertList.xlamはプロジェクトのロックをしてません。実際に使用する場合は誤って書き換えるかもしれないのでロックした方が良いでしょう。
InsertList.xlamを編集すると追加したメニューとコンボボックスのコマンドが実行できなくなります。実行するには一度閉じてから再度開いてください。

ツール バーのコンボボックス
ツール バーのコンボボックス

右クリックメニュー
右クリックメニュー

CmdBarModule
Option Explicit

Public Const mcToolBar As String = "テキストの挿入"
Public Const mcAddListFromSelectLine As String = "選択した行のテキストをリストに追加(&I)"
Public Const mcInsertList As String = "InsertListComboBox"

' リストに文字列がある場合はIndexをなければ-1を返します。
Function IndexOf(cmb As Office.CommandBarComboBox, TextList As String) As Long
  Dim i As Long

  IndexOf = -1
  With Application.VBE.CommandBars.Item(mcToolBar).Controls(cmb.Caption)
    For i = 1 To .ListCount
      If StrComp(TextList, .List(i), vbBinaryCompare) = 0 Then
        IndexOf = i
        Exit For
      End If
    Next i
  End With
End Function
' 選択したリストのテキストをカーソル行に挿入します。
Sub InsertList()
  Dim StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long
  Dim Text As String

  If Application.VBE.ActiveCodePane Is Nothing Then Exit Sub
  With Application.VBE.ActiveCodePane
    Text = Application.VBE.CommandBars.Item(mcToolBar).Controls(mcInsertList).Text
    .GetSelection StartLine, StartColumn, EndLine, EndColumn
    .CodeModule.InsertLines StartLine, Text
    .SetSelection StartLine, 1, StartLine, 1
    '
    With Application.VBE.CommandBars.Item(mcToolBar)
      If IndexOf(.Controls(mcInsertList), Text) < 1 Then
        .Controls(mcInsertList).AddItem Text
      End If
    End With
  End With
End Sub
' 選択した行のテキストをリストに追加
Sub AddListFromSelectLine()
  Dim i As Long
  Dim StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long
  Dim Text As String

  With Application.VBE.ActiveCodePane.CodeModule
    .CodePane.GetSelection StartLine, StartColumn, EndLine, EndColumn
    For i = StartLine To EndLine
      Text = .Lines(i, 1)
      With Application.VBE.CommandBars.Item(mcToolBar)
        If IndexOf(.Controls(mcInsertList), Text) < 1 Then
          .Controls(mcInsertList).AddItem Text
        End If
      End With
    Next i
    .CodePane.SetSelection StartLine, 1, StartLine, 1
  End With

End Sub
' --------------------------------------------------------------------------------------------------------------------------------------
' 下記からは使用してません。
'' コマンド バーのリセット
Private Sub ResetCommandBars()
  Dim CB As CommandBar

  If MsgBox(Prompt:="やり直しできませんが、すべてのVBEのコマンドバーをリセットしますか?", Buttons:=vbYesNo + vbQuestion, Title:="確認") <> vbYes Then Exit Sub
  On Error Resume Next
  Application.Cursor = xlWait ' 砂時計型ポインタ
  Application.StatusBar = "すべてのコマンドバーをリセットしてます。しばらくお待ちください..."
  For Each CB In Application.VBE.CommandBars
    If CB.BuiltIn Then
      Application.VBE.CommandBars(CB.Name).Reset ' 標準のコマンド バーは削除をリセット
    Else
      Application.VBE.CommandBars(CB.Name).Delete ' ユーザーのコマンド バーのみ削除
    End If
  Next
  Application.StatusBar = ""
  Application.Cursor = xlDefault ' 標準のポインタ
  On Error GoTo 0
End Sub

このページの上

ThisWorkbook
Option Explicit
' 【注意】VBEのClickイベントはOnActionではできません。クラス モジュールにWithEventsでCommandBarEventsとして宣言します。
Private Const csFileName = "InsertList.txt"

Dim CmdCtrl As CommandBarControl
Dim CmdEvtCls As CmdEventClass
Dim CmdEvtList As New Collection ' 複数のイベントの変数を保存します。

'' メニューの削除
Sub DeleteMenu()
  On Error Resume Next
  Application.VBE.CommandBars(mcToolBar).Delete
  Application.VBE.CommandBars("Code Window").Controls(mcAddListFromSelectLine).Delete
  On Error GoTo 0
End Sub
'' メニューの追加
Sub AddMenu()
  Dim i As Long

  For i = CmdEvtList.Count To 1 Step -1
    CmdEvtList.Remove i
  Next i
  ' コード ウィンドウの右クリック メニューの追加
  ' 選択した行のテキストをリストに追加
  Set CmdEvtCls = New CmdEventClass
  Set CmdCtrl = Application.VBE.CommandBars("Code Window").Controls.Add(msoControlButton)
  CmdCtrl.Caption = mcAddListFromSelectLine
  CmdCtrl.FaceId = 526
  Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
  CmdEvtList.Add CmdEvtCls
  ' 自作のコマンド バーに追加
  With Application.VBE.CommandBars.Add(Name:=mcToolBar, temporary:=True)
    .Visible = True
    ' カーソルの行に選択したテキストを挿入
    Set CmdEvtCls = New CmdEventClass
    Set CmdCtrl = .Controls.Add(msoControlComboBox)
    CmdCtrl.Caption = mcInsertList
    CmdCtrl.TooltipText = "カーソルの行に選択したテキストを挿入します。"
    CmdCtrl.Width = 200
    CmdCtrl.DropDownWidth = 650
    Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
    CmdEvtList.Add CmdEvtCls
  End With

  Set CmdEvtCls = Nothing
  Set CmdCtrl = Nothing
End Sub
' ファイルからComboBoxのリストに読み込みます。
Sub LoadFromFile()
  Dim FileName As String
  Dim buf As String
  Dim i As Long

  FileName = Application.ThisWorkbook.Path & Application.PathSeparator & csFileName
  With Application.VBE.CommandBars.Item(mcToolBar).Controls(mcInsertList)
    If Len(Dir(FileName)) > 0 Then ' ファイルが存在する場合は
      Err.Clear
      On Error GoTo Error_Handler
      Open FileName For Input As #1
      Do While Not EOF(1)
        Line Input #1, buf
        .AddItem buf
      Loop
      Close #1
      On Error GoTo 0
    End If
    ' ComboBoxのリストがない場合は
    If .ListCount < 1 Then
      .AddItem "  MsgBox Prompt:=""?"", Buttons:=vbQuestion + vbYesNo, Title:=""確認"""
      .AddItem "  MsgBox Prompt:="""", Buttons:=vbCritical, Title:=""エラー"""
      .AddItem "  MsgBox Prompt:="""", Buttons:=vbExclamation, Title:=""警告"""
      .AddItem "  MsgBox Prompt:="""", Buttons:=vbInformation, Title:=""情報"""
      .AddItem "  Ret = Application.InputBox(Prompt:=""アドレス:"", Title:=""セルのアドレス"", Default:=""A1"", Type:=8)"
      .AddItem "  Ret = Application.InputBox(Prompt:=""数字:"", Title:=""数字の入力"", Default:=10, Type:=1)"
      .AddItem "  Ret = Application.InputBox(Prompt:=""文字列:"", Title:=""文字列の入力"", Default:=""既定の文字列"", Type:=2)"
      .AddItem "  Debug.Print """""
      .AddItem "  Filename = Application.GetOpenFilename(FileFilter:=""エクセルファイル(*.xl*),*.xl*,テキストファイル(*.txt), *.txt,すべてのファイル(*.*),*.*"", FilterIndex:=1, Title:=""ファイルを開く"", ButtonText:=""開く"", MultiSelect:=False)"
      .AddItem "  Filename = Application.GetSaveAsFilename(InitialFileName:=""InitialFilenameBook.xlsx"", FileFilter:=""エクセルファイル(*.xl*),*.xl*,テキストファイル(*.txt), *.txt,すべてのファイル(*.*),*.*"", FilterIndex:=1, Title:=""名前を付けて保存"", ButtonText:=""保存"")"
      .AddItem "  Application.EnableEvents = False ' イベントを無効にします。"
      .AddItem "  Application.Calculation = xlCalculationManual ' 計算方法のモードを手動にし、計算しない"
      .AddItem "  Application.EnableCancelKey = xlErrorHandler ' ◆ Esc キーを押すとエラーにします。"
      .AddItem "  Application.StatusBar = ""実行中です。しばらくお待ちください..."""
      .AddItem "  Application.Cursor = xlWait ' マウスカーソルを砂時計"
      .AddItem "  Application.ScreenUpdating = False '画面の更新を停止"
    End If
  End With
  Exit Sub
Error_Handler:
  MsgBox Prompt:=Err.Number & ": " & Err.Description, Buttons:=vbCritical, Title:="エラー"
  Reset
End Sub
' ComboBoxのリストをファイルに保存します。
Sub SaveToFile()
  Dim FileName As String
  Dim i As Long

  Err.Clear
  On Error GoTo Error_Handler
  FileName = Application.ThisWorkbook.Path & Application.PathSeparator & csFileName
  Open FileName For Output As #1
  With Application.VBE.CommandBars.Item(mcToolBar).Controls(mcInsertList)
    For i = 1 To .ListCount
      Print #1, .List(i)
    Next i
  End With
  Close #1
  Exit Sub
Error_Handler:
  MsgBox Prompt:=Err.Number & ": " & Err.Description, Buttons:=vbCritical, Title:="エラー"
  Reset
End Sub
'' 初期処理
Private Sub Workbook_Open()
  Call DeleteMenu ' メニューの削除
  Call AddMenu ' メニューの追加
  Call LoadFromFile ' ファイルからComboBoxのリストに読み込みます。
End Sub
'' 終了処理
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  Call SaveToFile ' ComboBoxのリストをファイルに保存します。
  Call DeleteMenu ' メニューの削除
End Sub

このページの上

CmdEventClass
Option Explicit
'' VBE のコマンドのイベントのクラス
Public WithEvents CmdEvent As VBIDE.CommandBarEvents
'' メニューの処理
Private Sub CmdEvent_Click(ByVal CommandBarControl As Object, Handled As Boolean, CancelDefault As Boolean)
  Select Case CommandBarControl.Caption
    Case mcAddListFromSelectLine ' 選択した行のテキストをリストに追加
      Application.Run "CmdBarModule.AddListFromSelectLine"
    Case mcInsertList ' リストのテキストをカーソル行に挿入
      Application.Run "CmdBarModule.InsertList"
    Case Else
      MsgBox Prompt:=CommandBarControl.Caption & " コマンドの実行処理がありません!", Buttons:=vbCritical, Title:="エラー"
  End Select
  Handled = True
  CancelDefault = True
End Sub

このページの上