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

VBProject


【ファイル名】VBProject.xlsm
【バージョン】Ver 1.1.1
【作成日】2015年02月24日
【更新日】2015年02月28日
【動作確認】Windows 7
【必要なソフト】Microsoft Excel 2010
【ダウンロード】VBProject.zip
【説明】VBAからVisual Basic Editorを使用するサンプルです。
【注意】実行するにはオプションの「VBA プロジェクト オブジェクト モデルへのアクセルを信頼する」にチェックを入れます。

VBEのメニュー バーのメニュー、プロジェクト ウィンドウとコード ウィンドウの右クリックメニュー、ツール バーをカスタマイズします。
VBProject.xlsmを編集すると追加したメニューなどのコマンドが実行できなくなります。実行するには一度閉じてから再度開いてください。

実行時エラー'1004': プログラミングによる Visual Basic プロジェクトへのアクセスは信頼性に欠けます
マクロの設定
上記のエラーになる場合は下記のように設定を変更します。
1.「ファイル」メニューの「オプション」の「セキュリティ センター」の「セキュリティ センターの設定」ボタンを実行します。
2.「マクロの設定」の「開発者向けのマクロの設定」の「VBA プロジェクト オブジェクト モデルへのアクセルを信頼する」にチェックを入れ「OK」ボタンを実行します。
マクロの設定

1.VBIDEを使用する場合は「ツール」の「参照設定」メニューで「Microsoft Visiual Basic for Applications Extensibility」を追加します。
参照の設定のダイアログ

このページの上


マイクロソフトのサイトのVisual Basic add-in model referenceを参考しました。

オブジェクトの主なメソッドとプロパティ (オブジェクト ブラウザーを参照)
VBIDE  グローバルの定義
vbext_WindowType(vbext_wt_CodeWindow, vbext_wt_Immediate, vbext_wt_ProjectWindowなど)
vbext_ProcKind(vbext_pk_Get, vbext_pk_Let, vbext_pk_Proc, vbext_pk_Set)
vbext_ComponentType(vbext_ct_StdModule, vbext_ct_ClassModule, vbext_ct_MSForm, vbext_ct_Document, vbext_ct_ActiveXDesigner)

VBE
ActiveCodePane
ActiveVBProject  ' Application.VBE.ActiveVBProject
ActiveWindow
CodePanes
CommandBars
MainWindow
SelectedVBComponent  ' ActiveVBComponent ではありません
VBProjects
Version
Windows

VBProjects
Count
Open(bstrPath As String) As VBProject
Remove(lpc As VBProject)

VBProject
BuildFileName
Description
FileName
Name
References
Saved
Type
VBComponents

VBComponents
Add(ComponentType As vbext_ComponentType) As VBComponent
Count
Import(FileName As String) As VBComponent  ' 既に存在する場合は別の名前でインポートします。
Remove(VBComponent As VBComponent)  ' ブックとシートは削除できません。

VBComponent
Activate
CodeModule
Export(FileName As String)
Name  ' 名前の英字の小文字と大文字、半角と全角、カタカナとひらがなは区別しません。
Saved
Type

CodeModule
AddFromFile(FileName As String)  ' 最初のプロシージャーの前に挿入します。
AddFromString(String As String)  ' 最初のプロシージャーの前に挿入します。
CodePane
CountOfDeclarationLines As Long  ' 宣言セクション部分の行数
CountOfLines As Long
DeleteLines(StartLine As Long, [Count As Long = 1])
Find(Target As String, StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long, [WholeWord As Boolean = False], [MatchCase As Boolean = False], [PatternSearch As Boolean = False]) As Boolean  ' 【注意】全角の桁は2で計算します。
InsertLines(Line As Long, String As String)
Lines(StartLine As Long, Count As Long) As String
ProcBodyLine(ProcName As String, ProcKind As vbext_ProcKind) As Long
ProcCountLines(ProcName As String, ProcKind As vbext_ProcKind) As Long
ProcOfLine(Line As Long, ProcKind As vbext_ProcKind) As String
ProcStartLine(ProcName As String, ProcKind As vbext_ProcKind) As Long ' 【注意】前のプロシージャーの次の行を返します。
ReplaceLine(Line As Long, String As String)

CodePanes
Count

CodePane
CodeModule
CodePaneView
CountOfVisibleLines As Long
GetSelection(StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long)  ' 【注意】全角の桁は2で計算します。
SetSelection(StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long)  ' 【注意】全角の桁は2で計算します。
Show()
TopLine As Long

References
AddFromFile(FileName As String) As Reference
AddFromGuid(Guid As String, Major As Long, Minor As Long) As Reference
Count
Remove(Reference As Reference)

Reference
BuiltIn
Description
FullPath
Guid
IsBroken
Major
Minor
Name
Type
【注意】VBEのClickイベントはOnActionではできません。クラス モジュールにWithEventsでCommandBarEventsとして宣言します。
【注意】CodeModuleのProcStartLineは前のプロシージャーの次の行を返します。
【注意】VBEはShift JISで(MsgBox, Debug.Print)、VBAはUnicodeと思われます。桁は半角は1、全角は2で計算します。

このページの上

メニュー バーのメニュー
メニュー バーのメニュー

プロジェクト ウィンドウの右クリック メニュー
プロジェクト ウィンドウの右クリック メニュー

コード ウィンドウの右クリック メニュー
コード ウィンドウの右クリック メニュー

ツールバー
ツールバー

このページの上

VBE_Module
Option Explicit
' VBEのバージョンを表示します。
Sub Display_VBE_Version_Sample()
  MsgBox Prompt:="VBE.Version = " & Application.VBE.Version, Buttons:=vbInformation, Title:="VBE.Version"
End Sub
' VBEのプロパティをイミディエイト ウィンドウに表示します。
Sub VBE_Sample()
  With Application.VBE
    Debug.Print "ActiveCodePane.TopLine: " & .ActiveCodePane.TopLine
    Debug.Print "ActiveVBProject.Name: " & .ActiveVBProject.Name
    Debug.Print "ActiveWindow.Caption: " & .ActiveWindow.Caption
    Debug.Print "Addins.Count: " & .AddIns.Count
    Debug.Print "CodePanes.Count: " & .CodePanes.Count
    Debug.Print "CommandBars.Count: " & .CommandBars.Count
    Debug.Print "MainWindow.Caption: " & .MainWindow.Caption
    Debug.Print "SelectedVBComponent.Name: " & .SelectedVBComponent.Name
    Debug.Print "VBProjects.Count: " & .VBProjects.Count
    Debug.Print "Version: " & .Version
    Debug.Print "Windows.Count: " & .Windows.Count
  End With
End Sub
' VBEのコマンドバーの一覧のブックを作成します。
Sub Crate_CommandBars_List()
  Dim i As Long
  Dim wb As Workbook

  Set wb = Workbooks.Add
  wb.Worksheets(1).Cells(1, 1) = "Type"
  wb.Worksheets(1).Cells(1, 2) = "Name"
  wb.Worksheets(1).Cells(1, 3) = "NameLocal"
  With Application.VBE.CommandBars
    For i = 1 To .Count
      wb.Worksheets(1).Cells(i + 1, 1) = .Item(i).Type
      wb.Worksheets(1).Cells(i + 1, 2) = .Item(i).Name
      wb.Worksheets(1).Cells(i + 1, 3) = .Item(i).NameLocal
    Next i
  End With

  wb.Worksheets(1).Range("B:C").Columns.AutoFit
  wb.Worksheets(1).Range("A1").Select
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 = "すべてのVBEのコマンドバーをリセットしてます。しばらくお待ちください..."
  For Each cb In Application.VBE.CommandBars
    If cb.BuiltIn Then
      cb.Reset ' 標準のコマンド バーはリセット
    Else
      cb.Delete ' ユーザーのコマンド バーは削除
    End If
  Next
  Application.StatusBar = ""
  Application.Cursor = xlDefault ' 標準のカーソルポインタ
  On Error GoTo 0
End Sub
' VBEのアドイン一覧をイミディエイト ウィンドウに表示します。
Sub Addin_Sample()
  Dim i As Long

  With Application.VBE.AddIns
    If .Count < 1 Then
      MsgBox Prompt:="VBEのアドインはインストールしてません!", Buttons:=vbInformation, Title:="VBE.AddIns.Count"
      Exit Sub
    End If
    For i = 1 To .Count
      Debug.Print "progID:" & .Item(i).progID
      Debug.Print "Connect:" & .Item(i).Connect
      Debug.Print "Description:" & .Item(i).Description
      Debug.Print "GUID:" & .Item(i).GUID
      Debug.Print ""
    Next i
  End With
End Sub
' Windowの一覧をイミディエイト ウィンドウに表示します。
' vbext_WindowType(0=vbext_wt_CodeWindow, 5=vbext_wt_Immediate, 6=vbext_wt_ProjectWindowなど)
Sub Windows_Sample()
  Dim i As Long

  With Application.VBE.Windows
    For i = 1 To .Count
      Debug.Print "Caption:" & .Item(i).Caption
      Debug.Print "Top:" & .Item(i).Top
      Debug.Print "Left:" & .Item(i).Left
      Debug.Print "Width:" & .Item(i).Width
      Debug.Print "Height:" & .Item(i).Height
      Debug.Print "Visible:" & .Item(i).Visible
      Debug.Print "Type:" & .Item(i).Type
      Debug.Print "WindowState:" & .Item(i).WindowState
      Debug.Print ""
    Next i
  End With
End Sub
' イミディエイト ウィンドウを表示しアクティブにします。
Sub Immediate_Window_SetFocus_Sample()
  Dim i As Long

  With Application.VBE.Windows
    For i = 1 To .Count
      If .Item(i).Type = vbext_wt_Immediate Then
        .Item(i).Visible = True
        .Item(i).SetFocus
        Exit For
      End If
    Next i
  End With
End Sub
Sub Immediate_Window_SetFocus_Sample_2()
  With Application.VBE.Windows
    .Item("イミディエイト").Visible = True ' ◆ 日本語のエクセルのみ実行可能
    .Item("イミディエイト").SetFocus       ' ◆ (旧いエクセルでは半角カタカナの「イミディエイト」なので実行できません)
  End With
End Sub

このページの上

 VBProject_Module
Option Explicit
' すべてのプロジェクトのファイル名をイミディエイト ウィンドウに表示します。
Sub VBProjects_Sample()
  Dim i As Long

  For i = 1 To Application.VBE.VBProjects.Count
    Debug.Print Application.VBE.VBProjects(i).FileName
  Next i
End Sub
' アクティブ プロジェクトのプロパティをイミディエイト ウィンドウに表示します。
Sub ActiveVBProject_Sample()
  With Application.VBE.ActiveVBProject
    Debug.Print "BuildFileName:" & .BuildFileName
    Debug.Print "Description:" & .Description
    Debug.Print "FileName:" & .FileName
    Debug.Print "Name:" & .Name
    Debug.Print "References.Count:" & .References.Count
    Debug.Print "Saved:" & .Saved
    Debug.Print "Type:" & .Type ' vbext_pt_HostProject = 100  or  vbext_pt_StandAlone = 101
    Debug.Print "VBComponents.Count:" & .VBComponents.Count
  End With
End Sub
' アクティブ プロジェクトのモードをイミディエイト ウィンドウに表示します。
Sub VBAMode_Sample()
  Select Case Application.VBE.ActiveVBProject.Mode
    Case vbext_vm_Run
      MsgBox Prompt:="vbext_vm_Run", Buttons:=vbInformation, Title:="ActiveVBProject.Mode"
    Case vbext_vm_Break
      MsgBox Prompt:="vbext_vm_Break", Buttons:=vbInformation, Title:="ActiveVBProject.Mode"
    Case vbext_vm_Design
      MsgBox Prompt:="vbext_vm_Design", Buttons:=vbInformation, Title:="ActiveVBProject.Mode"
  End Select
End Sub
' プロジェクトを保存したか表示します。
Sub Display_VBE_ActiveVBProject_Saved()
  MsgBox Prompt:="VBE.ActiveVBProject.Saved = " & Application.VBE.ActiveVBProject.Saved, Buttons:=vbInformation, Title:="VBE.ActiveVBProject.Saved"
End Sub
'  アクティブ プロジェクト「参照設定」の一覧をイミディエイト ウィンドウに表示します。
' エクセルのシートに貼り付けた後で複数の列に分けるには、「データ」タブの「区切り位置」を実行しカンマを選択します。
Sub Debug_Print_References()
  Dim i As Long

  With Application.VBE.ActiveVBProject
    Debug.Print "BuiltIn, Name, Description, FullPath, GUID"
    For i = 1 To .References.Count
      Debug.Print .References(i).BuiltIn & ", " & .References(i).Name & ", """ & .References(i).Description _
                  & """, """ & .References(i).FullPath & """, " & .References(i).GUID
    Next i
  End With
End Sub

このページの上

 VBComponent_Module
Option Explicit

' コンポーネントのタイプを取得します。
' vbext_ComponentType
'     1 vbext_ct_StdModule = 標準モジュール
'     2 vbext_ct_ClassModule = クラスモジュール
'     3 vbext_ct_MSForm = フォーム
'    11 vbext_ct_ActiveXDesigner = ActiveXDesigner
'   100 vbext_ct_Document = ドキュメント(Workbook,Worksheetなど)
Sub VBComponents_Type_Sample()
  Dim i As Long

  If ActiveWorkbook Is Nothing Then Exit Sub
  With ActiveWorkbook.VBProject
    For i = 1 To .VBComponents.Count
      Debug.Print .VBComponents(i).Type & ", " & .VBComponents(i).Name
    Next i
  End With
End Sub
' DeleteModuleモジュールを削除します。
Sub VBComponents_Remove_Sample()
  Const DeleteName = "DeleteModule"
  Dim ret As VbMsgBoxResult
  Dim VBC As VBIDE.VBComponent

  On Error Resume Next
  Set VBC = ThisWorkbook.VBProject.VBComponents(DeleteName)
  On Error GoTo 0
  If VBC Is Nothing Then Exit Sub ' モジュールは存在しない!
  ret = MsgBox(Prompt:=DeleteName & " モジュールを削除しますか?", Buttons:=vbYesNo + vbQuestion, Title:="確認")
  If ret <> vbYes Then Exit Sub
  With ThisWorkbook.VBProject.VBComponents
    .Remove .Item(DeleteName)
  End With
End Sub
' 選択してるモジュール名を表示します。
Sub SelectedVBComponent_Name_Sample()
  MsgBox Prompt:="選択してるモジュール名:" & Application.VBE.SelectedVBComponent.Name, Buttons:=vbYesNo + vbQuestion, Title:="SelectedVBComponent.Name"
End Sub

' パス名からファイル名を除いて、パスを取得します。(最後に「\」はつきません。コロン「:」がなくかつ円記号「\」がない場合はファイルとします)
Function GetPathName(PathName As String) As String
  Dim l As Long ' 文字数
  Dim yen As Long ' \ フォルダの区切り記号の位置
  Dim colon As Long ' : ドライブの記号の位置

  yen = InStrRev(PathName, Application.PathSeparator, Compare:=vbBinaryCompare)
  colon = InStrRev(PathName, ":", Compare:=vbBinaryCompare)
  l = Len(PathName)

  GetPathName = PathName
  If PathName = "." Then Exit Function
  If PathName = ".." Then Exit Function

  If yen > 0 Then
    GetPathName = Left$(PathName, yen - 1)
  ElseIf colon > 0 Then
    GetPathName = PathName ' ドライブ
  Else
    GetPathName = vbNullString ' 円記号「\」がない場合はファイルとします
  End If
End Function
' ActiveVBProjectと同じフォルダに標準モジュール、クラスモジュール、フォームをファイルにエクスポートします。
Sub VBComponents_Export()
  Dim i As Long
  Dim Path As String

  If Application.VBE.ActiveVBProject Is Nothing Then Exit Sub
  With Application.VBE.ActiveVBProject
    Path = GetPathName(.FileName) ' ファイル名を除いて、フォルダ名を取得します。
    If Right$(Path, 1) <> Application.PathSeparator Then Path = Path & Application.PathSeparator ' \を足します。
    For i = 1 To .VBComponents.Count
      With .VBComponents(i)
        Select Case .Type
          Case Is = vbext_ct_StdModule
            .Export Path & "\" & .Name & ".bas"
          Case Is = vbext_ct_ClassModule
            .Export Path & "\" & .Name & ".cls"
          Case Is = vbext_ct_MSForm
            .Export Path & "\" & .Name & ".frm"
          Case Is = vbext_ct_Document ' Workbook, Worksheetなど
            .Export Path & "\" & .Name & ".cls"
          Case Is = vbext_ct_ActiveXDesigner ' ActiveX デザイナ
            .Export Path & "\" & .Name & ".cls"
        End Select
      End With
    Next i
  End With
End Sub
' 指定した名前のVBComponentが存在しているか調べます。
Function ExistsVBComponent(VBComponentName As String, Optional pVBProject As Variant)
  Dim VBPro As VBIDE.VBProject
  Dim VBCom As VBIDE.VBComponent

  ExistsVBComponent = False
  On Error Resume Next
  If IsMissing(pVBProject) Then
    If Application.VBE.ActiveVBProject Is Nothing Then Exit Function
    Set VBPro = Application.VBE.ActiveVBProject
  Else
    Set VBPro = pVBProject
  End If
  Set VBCom = VBPro.VBComponents(VBComponentName)
  ExistsVBComponent = Not (VBCom Is Nothing)
  On Error GoTo 0
  Set VBCom = Nothing
  Set VBPro = Nothing
End Function

このページの上

 CodeModule_Module
Option Explicit
' CodeModuleの処理は [Ctrl] + [Z] キーで編集を戻せる場合があります。

' アクティブ モジュールの宣言セクション部分の行数を返します。
Sub CountOfDeclarationLines_Sample()
  Dim Line As Long

  Line = Application.VBE.ActiveCodePane.CodeModule.CountOfDeclarationLines
  MsgBox Prompt:="宣言セクション部分の行数:" & Line, Buttons:=vbInformation, Title:="CodeModule.CountOfDeclarationLines"
End Sub
' アクティブ モジュールの行数を返します。
Sub CountOfLines_Sample()
  Dim Line As Long

  Line = Application.VBE.ActiveCodePane.CodeModule.CountOfLines
  MsgBox Prompt:="モジュールの行数:" & Line, Buttons:=vbInformation, Title:="CodeModule.CountOfLines"
End Sub
' プロシージャーの行数を返します。
' 【注意】プロシージャーの前の行にコメントがある場合は、コメントの行を含めます。
Sub ProcCountLines_Sample()
  Dim StartLine As Long

  StartLine = ThisWorkbook.VBProject.VBComponents("Code_Module").CodeModule.ProcCountLines(ProcName:="ProcCountLines_Sample", ProcKind:=vbext_pk_Proc)
  MsgBox Prompt:="コメントの行を含むプロシージャーの行数:" & StartLine, Buttons:=vbInformation, Title:="CodeModule.ProcCountLines"
End Sub
' プロシージャーの開始行を返します。(プロシージャーの前の行にあるコメント行を含みます。)
' 【注意】前のプロシージャーの次の行を返します。
'  vbext_ProcKind
'    vbext_pk_Get
'    vbext_pk_Let
'    vbext_pk_Proc
'    vbext_pk_Set
Sub ProcStartLine_Sample()
  Dim StartLine As Long

  StartLine = ThisWorkbook.VBProject.VBComponents("Code_Module").CodeModule.ProcStartLine(ProcName:="ProcStartLine_Sample", ProcKind:=vbext_pk_Proc)
  MsgBox Prompt:="コメント行を含むプロシージャーの開始行:" & StartLine, Buttons:=vbInformation, Title:="CodeModule.ProcStartLine"
End Sub
' プロシージャーの開始行を返します。
Sub ProcBodyLine_Sample()
  Dim StartLine As Long

  StartLine = ThisWorkbook.VBProject.VBComponents("Code_Module").CodeModule.ProcBodyLine(ProcName:="ProcBodyLine_Sample", ProcKind:=vbext_pk_Proc)
  MsgBox Prompt:="プロシージャーの開始行:" & StartLine, Buttons:=vbInformation, Title:="CodeModule.ProcBodyLine"
End Sub
' コードモジュールの指定行から指定した行数のテキストを取得します。
' 【注意】CodeModule.LinesはUnicodeなので、半角でも2バイトです。
Sub Lines_Sample()
  Dim StartLine As Long, Count As Long

  StartLine = 3
  Count = 8
  MsgBox Prompt:=ThisWorkbook.VBProject.VBComponents("Code_Module").CodeModule.Lines(StartLine, Count), Buttons:=vbInformation, Title:="CodeModule.Lines"
End Sub
' 指定した行が含まれるプロシージャー名を取得します。
Sub ProcOfLine_Sample()
  Dim Num As Variant
  Dim ProcName As String

  Num = Application.InputBox(Prompt:="行数:", Title:="プロシージャー名の行数の入力", Default:=57, Type:=1)
  If TypeName(Num) <> "Double" Then Exit Sub ' [キャンセル]ボタン
  ProcName = ThisWorkbook.VBProject.VBComponents("Code_Module").CodeModule.ProcOfLine(Line:=Num, ProcKind:=vbext_pk_Proc)
  MsgBox Prompt:="プロシージャー名:" & ProcName, Buttons:=vbInformation, Title:="CodeModule.ProcOfLine"
End Sub
' 選択したテキストファイルをTempModuleモジュールの最初のプロシージャーの前に挿入します。
Sub AddFromFile_Sample()
  Dim FileName As Variant

  FileName = Application.GetOpenFilename(FileFilter:="テキストファイル(*.txt), *.txt,すべてのファイル(*.*),*.*", FilterIndex:=1, Title:="ファイルのインポート", ButtonText:="インポート", MultiSelect:=False)
  If TypeName(FileName) = "Boolean" Then Exit Sub ' [キャンセル]ボタン
  ThisWorkbook.VBProject.VBComponents("TempModule").CodeModule.AddFromFile FileName
End Sub
' テキストをTempModuleモジュールの最初のプロシージャーの前に挿入します。
Sub AddFromString_Sample()
  Dim Str As String

  Str = "'" & String(50, "=") & vbCrLf
  Str = Str & "'AddFromStringで挿入しました。 " & Format(Now, "yyyy/mm/dd hh:mm:ss") & vbCrLf & Str
  ThisWorkbook.VBProject.VBComponents("TempModule").CodeModule.AddFromString Str
End Sub
' テキストをTempModuleモジュールの5行目に挿入します。
Sub InsertLines_Sample()
  Dim Str As String

  Str = "' 5行目にInsertLinesで挿入しました。" & vbCrLf & "' vbCrLfを使用すると複数の行を挿入できます。"
  ThisWorkbook.VBProject.VBComponents("TempModule").CodeModule.InsertLines 5, Str
End Sub
' 現在のカーソルの開始行に日付と時間を挿入します。
Sub Insert_Text()
  Dim StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long
  Dim Text As String

  Text = Format(Now, "' ggge年mm月dd日 hh時mm分ss秒")
  With Application.VBE.ActiveCodePane
    .GetSelection StartLine, StartColumn, EndLine, EndColumn
    .CodeModule.InsertLines StartLine, Text
  End With
End Sub
' TempModuleモジュールの5行目と6行目の2行を削除します。
Sub DeleteLines_Sample()
  Dim StartLine As Long, CountLine As Long

  StartLine = 5
  CountLine = 2
  ThisWorkbook.VBProject.VBComponents("TempModule").CodeModule.DeleteLines StartLine, CountLine
End Sub
' 検索した文字列があるかを表示します。
' Find(Target As String, StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long, [WholeWord As Boolean = False], [MatchCase As Boolean = False], [PatternSearch As Boolean = False]) As Boolean
' 【注意】StartColumnとEndColumnの桁は半角は1、全角は2で計算します。
Sub Find_Sample()
  Dim ret As Boolean
  Dim FindText As Variant

  FindText = Application.InputBox(Prompt:="文字列:", Title:="文字列の検索", Type:=2)
  If TypeName(FindText) = "Boolean" Then Exit Sub
  If Len(FindText) < 1 Then Exit Sub
  With ThisWorkbook.VBProject.VBComponents("Code_Module").CodeModule
    ret = .Find(FindText, 1, 1, .CountOfLines, LenB(.Lines(.CountOfLines, 1)), False, False, False) ' 【注意】LenではなくLenBを使います。
  End With
  MsgBox Prompt:=FindText & "の検索結果 = " & ret, Buttons:=vbInformation, Title:="文字列の検索"
End Sub
' TempModuleモジュールの5行目を文字列で置き換えます。
Sub ReplaceLine_Sample()
  Dim Str As String

  Str = "' 5行目をReplaceLineで置き換えしました。 " & Format(Now, "yyyy/mm/dd hh:mm:ss")
  ThisWorkbook.VBProject.VBComponents("TempModule").CodeModule.ReplaceLine 5, Str
End Sub
' アクティブ コンポーネントのすべてのプロシージャ名を表示します。(クラスのGet, Set, Letは除きます)
Sub Display_ProcName_Sample()
  Dim Msg As String
  Dim ProcName As String
  Dim i As Long

  ProcName = vbNullString
  With Application.VBE.ActiveCodePane.CodeModule
    For i = 1 To .CountOfLines
      If ProcName <> .ProcOfLine(i, ProcKind:=vbext_pk_Proc) Then ' プロシージャ名が変わった場合は
        ProcName = .ProcOfLine(i, ProcKind:=vbext_pk_Proc)
'        Debug.Print buf
        Msg = Msg & ProcName & vbCrLf
      End If
    Next i
  End With

  MsgBox Prompt:=Msg, Buttons:=vbInformation, Title:="プロシージャ名の一覧"
End Sub

このページの上

 CodePane_Module
Option Explicit

' 選択範囲のカーソル位置を取得します。
' 【注意】StartColumnとEndColumnの桁は半角は1、全角は2で計算します。
Sub GetSelection_Sample()
  Dim StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long
  Dim Msg As String

  Application.VBE.ActiveCodePane.GetSelection StartLine, StartColumn, EndLine, EndColumn
  Msg = "開始:" & StartLine & "行 " & StartColumn & "桁" & vbCrLf & vbCrLf
  Msg = Msg & "終了:" & EndLine & "行" & EndColumn & "桁"
  MsgBox Prompt:=Msg, Buttons:=vbInformation, Title:="カーソル位置"
End Sub
' 選択範囲を設定します。
' 【注意】StartColumnとEndColumnの桁は半角は1、全角は2で計算します。
' 【注意】左端の桁は0ではなく1です。
Sub SetSelection_Sample()
  Dim StartLine As Long, StartColumn As Long, EndLine As Long, EndColumn As Long

  StartLine = 14: StartColumn = 7: EndLine = 22: EndColumn = 8 ' ◆ StartColumnは全角は2で計算してます。
  Application.VBE.ActiveCodePane.SetSelection StartLine, StartColumn, EndLine, EndColumn
End Sub
' アクティブ コード ペインの画面に表示できる行数を表示します。
Sub CountOfVisibleLines_Sample()
  MsgBox Prompt:="画面に表示できる行数:" & Application.VBE.ActiveCodePane.CountOfVisibleLines, Buttons:=vbInformation, Title:="ActiveCodePane.CountOfVisibleLines"
End Sub
' アクティブ コード ペインの画面の最上行を表示します。
Sub TopLine_Sample()
  MsgBox Prompt:="画面の最上行:" & Application.VBE.ActiveCodePane.TopLine, Buttons:=vbInformation, Title:="ActiveCodePane.TopLine"
End Sub

このページの上

 OtherModule
Option Explicit
' 【注意】実行するにはオプションの「VBA プロジェクト オブジェクト モデルへのアクセルを信頼する」にチェックを入れます。
' 「ツール」の「参照設定」メニューで「Microsoft Visiual Basic for Applications Extensibility」を追加しました。

'---< キーをSendKeysでエミュレーションします。 >--------------------------------------
' 先頭行に移動します。
Sub Goto_Top()
  SendKeys "^{HOME}"
End Sub
' 最終行に移動します。
Sub Goto_Bottom()
  SendKeys "^{END}"
End Sub
' 前のプロシージャーに移動します。
Sub Goto_Prev_Proc()
  SendKeys "^{UP}"
End Sub
' 次のプロシージャーに移動します。
Sub Goto_Next_Proc()
  SendKeys "^{DOWN}"
End Sub
' [Ctrl] + [Y]で現在の1行を削除します。
Sub Delete_Current_Line()
'  SendKeys "^{y}"
End Sub
' イミディエイト ウィンドウを表示します。
Sub Dsiplay_Immediate_Window()
  SendKeys "^{g}"
End Sub

このページの上

 MenuModule
Option Explicit

Public Const mcToolBar As String = "Suyama VBE ToolBar"
Public Const mcStandard As String = "標準"
Public Const mcEdit As String = "編集"
Public Const mcDebug As String = "デバッグ"
Public Const mcUserForm As String = "ユーザー フォーム"

Public Const mcMainMenu As String = "Suyama VBE(&S)"

Public Const mcDateMenu As String = "Date(&D)"
Public Const mcTimeMenu As String = "Time(&T)"

Public Const mcActiveVBProjectFileNameMenu As String = "ActiveVBProject.FileName(&F)"
Public Const mcCountOfLines As String = "CountOfLines(&L)"

このページの上

 ThisWorkbook
Option Explicit
' 【注意】VBEのClickイベントはOnActionではできません。クラス モジュールにWithEventsでCommandBarEventsとして宣言します。
Dim CmdCtrl As CommandBarControl
Dim CmdEvtCls As CmdEventClass
Dim CmdEvtList As New Collection ' 複数のイベントの変数を保存します。

' メニューの削除
Sub DeleteMenu()
  On Error Resume Next
  ' メニュー バーのメニューの削除
  Application.VBE.CommandBars("メニュー バー").Controls(mcMainMenu).Delete
  ' コード ウィンドウの右クリック メニューの削除
  Application.VBE.CommandBars("Code Window").Controls(mcMainMenu).Delete
  ' プロジェクト ウィンドウの右クリック メニューの削除
  Application.VBE.CommandBars("Project Window").Controls(mcActiveVBProjectFileNameMenu).Delete
  ' 自作したツールバーの削除
  Application.VBE.CommandBars(mcToolBar).Delete
  ' ツール バーに追加したコマンド ボタンの削除
  Application.VBE.CommandBars("標準").Controls(mcStandard).Delete
  Application.VBE.CommandBars("編集").Controls(mcEdit).Delete
  Application.VBE.CommandBars("デバッグ").Controls(mcDebug).Delete
  Application.VBE.CommandBars("ユーザー フォーム").Controls(mcUserForm).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
  ' メニュー バーのメニューの追加
  With Application.VBE.CommandBars("メニュー バー").Controls.Add(Type:=msoControlPopup, Temporary:=True) ' Temporary:=True で終了時に削除
    .Caption = mcMainMenu
    ' 日付メニュー
    Set CmdEvtCls = New CmdEventClass
    Set CmdCtrl = .Controls.Add(msoControlButton)
    CmdCtrl.Caption = mcDateMenu
    CmdCtrl.FaceId = 8
    Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
    CmdEvtList.Add CmdEvtCls ' イベントの変数は上書きされません。保存されます。
    ' 時間メニュー
    Set CmdEvtCls = New CmdEventClass
    Set CmdCtrl = .Controls.Add(msoControlButton)
    CmdCtrl.Caption = mcTimeMenu
    CmdCtrl.FaceId = 33
    Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
    CmdEvtList.Add CmdEvtCls ' イベントの変数は上書きされません。保存されます。
  End With
  ' プロジェクト ウィンドウの右クリック メニューの追加
  Set CmdEvtCls = New CmdEventClass
  Set CmdCtrl = Application.VBE.CommandBars("Project Window").Controls.Add(Type:=msoControlButton, Temporary:=True)
  CmdCtrl.Caption = mcActiveVBProjectFileNameMenu
  CmdCtrl.FaceId = 481
  Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
  CmdEvtList.Add CmdEvtCls
  ' コード ウィンドウの右クリック メニューの追加
  With Application.VBE.CommandBars("Code Window").Controls.Add(Type:=msoControlPopup, Temporary:=True) ' Temporary:=True で終了時に削除
    .Caption = mcMainMenu
    ' 行数の表示メニュー
    Set CmdEvtCls = New CmdEventClass
    Set CmdCtrl = .Controls.Add(msoControlButton)
    CmdCtrl.Caption = mcCountOfLines
    CmdCtrl.FaceId = 482
    Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
    CmdEvtList.Add CmdEvtCls ' イベントの変数は上書きされません。保存されます。
  End With
  ' 自作したツールバーの追加
  With Application.VBE.CommandBars.Add(mcToolBar, Temporary:=True)
    .Visible = True
    ' 日付ボタン
    Set CmdEvtCls = New CmdEventClass
    Set CmdCtrl = .Controls.Add(msoControlButton)
    CmdCtrl.Caption = mcDateMenu
    CmdCtrl.FaceId = 8
    CmdCtrl.TooltipText = "今日の日付を表示します。"
    Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
    CmdEvtList.Add CmdEvtCls ' イベントの変数は上書きされません。保存されます。
    ' 時間ボタン
    Set CmdEvtCls = New CmdEventClass
    Set CmdCtrl = .Controls.Add(msoControlButton)
    CmdCtrl.Caption = mcTimeMenu
    CmdCtrl.FaceId = 33
    CmdCtrl.TooltipText = "今の時間を表示します。"
    Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
    CmdEvtList.Add CmdEvtCls ' イベントの変数は上書きされません。保存されます。
  End With

  ' 標準
  Set CmdEvtCls = New CmdEventClass
  Set CmdCtrl = Application.VBE.CommandBars("標準").Controls.Add(msoControlButton)
  CmdCtrl.Caption = mcStandard
  CmdCtrl.FaceId = 481
  CmdCtrl.TooltipText = "メッセージを表示します。"
  Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
  CmdEvtList.Add CmdEvtCls
  ' 編集
  Set CmdEvtCls = New CmdEventClass
  Set CmdCtrl = Application.VBE.CommandBars("編集").Controls.Add(msoControlButton)
  CmdCtrl.Caption = mcEdit
  CmdCtrl.FaceId = 482
  CmdCtrl.TooltipText = "メッセージを表示します。"
  Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
  CmdEvtList.Add CmdEvtCls
  ' デバッグ
  Set CmdEvtCls = New CmdEventClass
  Set CmdCtrl = Application.VBE.CommandBars("デバッグ").Controls.Add(msoControlButton)
  CmdCtrl.Caption = mcDebug
  CmdCtrl.FaceId = 483
  CmdCtrl.TooltipText = "メッセージを表示します。"
  Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
  CmdEvtList.Add CmdEvtCls
  ' ユーザー フォーム
  Set CmdEvtCls = New CmdEventClass
  Set CmdCtrl = Application.VBE.CommandBars("ユーザー フォーム").Controls.Add(msoControlButton)
  CmdCtrl.Caption = mcUserForm
  CmdCtrl.FaceId = 484
  CmdCtrl.TooltipText = "メッセージを表示します。"
  Set CmdEvtCls.CmdEvent = Application.VBE.Events.CommandBarEvents(CmdCtrl)
  CmdEvtList.Add CmdEvtCls

  Set CmdEvtCls = Nothing
  Set CmdCtrl = Nothing
End Sub
' 初期処理
Private Sub Workbook_Open()
  Call DeleteMenu ' メニューの削除
  Call AddMenu ' メニューの追加
End Sub
' 終了処理
Private Sub Workbook_BeforeClose(Cancel As Boolean)
  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 mcActiveVBProjectFileNameMenu
      If Not Application.VBE.ActiveVBProject Is Nothing Then
        MsgBox Prompt:=Application.VBE.ActiveVBProject.FileName, Buttons:=vbInformation, Title:="ActiveVBProject.FileName"
      End If
    Case mcCountOfLines
      MsgBox Prompt:="CountOfLines = " & Application.VBE.ActiveCodePane.CodeModule.CountOfLines, Buttons:=vbInformation, Title:="CountOfLines"
    Case mcDateMenu
      MsgBox Prompt:=Format(Date, "yyyy/mm/dd"), Buttons:=vbInformation, Title:="日付"
    Case mcTimeMenu
      MsgBox Prompt:=Format(Time, "hh:mm:ss"), Buttons:=vbInformation, Title:="時間"
    Case mcStandard, mcEdit, mcDebug, mcUserForm
      MsgBox Prompt:="このツール バーは " & CommandBarControl.Caption & " です。"
    Case Else
      MsgBox Prompt:=CommandBarControl.Caption & " コマンドの実行処理がありません!", Buttons:=vbCritical, Title:="エラー"
  End Select
  Handled = True
  CancelDefault = True
End Sub

このページの上