アクティブブックのプロシージャ一覧を表示し選択してVBEを開く、コードを出力する実験 Excel2000 VBA [Excel2000 VBA独習]
アクティブブックのプロシージャ一覧を表示し選択してVBEを開く、コードを出力する実験
Excel2002以降は「Visual Basicプロジェクトへのアクセスを信頼する」チェックボックスをオンにする。
http://officetanaka.net/excel/vba/vbe/01.htm 参照
ユーザフォームのリストボックスにモジュール名、プロシージャ一覧を表示し、選択したモジュールをテキスト出力しエクスプローラを開く。
同様にプロシージャ名からVBEを開く。
作成するユーザーフォーム
Sub workbookのプロシージャ一覧()
'ユーザーフォームのリストボックスに
'アクティブブックのプロシージャ名一覧を表示
'プロシージャを選択してVBEを起動
'事前にユーザーフォームを作成
'参考にしたサイト
'http://www.officetanaka.net/excel/vba/vbe/05.htm
On Local Error Resume Next 'エラーが出るのでエラーが出ても実行
Dim buf, book_name As String
Dim procNames(100) As String
Dim i, j, p, cou As Long
Dim x As Long
Dim moduleName, z As Variant
Dim mN(20) As String
Dim VBcop_count As Integer
Dim moji, moji_1 As Variant
'Workbookのモジュール数を調べる 数が合わないような・・・
VBcop_count = ActiveWorkbook.VBProject.VBComponents.Count
'モジュール名取得
For Each moduleName In ActiveWorkbook.VBProject.VBComponents
If (moduleName.Type = 1 Or moduleName.Type = 2) And moduleName.Name <> "VBE" Then
i = i + 1
mN(i) = moduleName.Name
'Debug.Print mN(i)
End If
Next
'プロシージャ名取得
For x = 1 To VBcop_count
With ActiveWorkbook.VBProject.VBComponents(mN(x)).CodeModule
' Debug.Print mN(x)
For i = 1 To .CountOfLines
If buf <> .ProcOfLine(i, 0) Then
buf = .ProcOfLine(i, 0)
procNames(j) = mN(x) & vbTab & buf
'Debug.Print procNames(j)
j = j + 1
cou = cou + 1 'プロシージャ数
End If
Next i
End With
Next x
'---- フォームにプロシージャ一覧を表示 ----
'一行目に項目名を設定
UserForm3.ListBox1.AddItem ActiveWorkbook.Name
UserForm3.ListBox1.AddItem " "
UserForm3.ListBox1.AddItem "モジュール名 プロシージャ名"
UserForm3.ListBox1.AddItem " "
For i = 1 To cou
UserForm3.ListBox1.AddItem procNames(i)
UserForm3.ListBox1.AddItem " "
Next i
'フォーム表示
UserForm3.Show vbModeless
End Sub
ボタン1(選択マクロの編集)が押されたら
Private Sub CommandButton1_Click()
'選択テキストからマクロ名を調べてVBEで開く
On Error Resume Next
Dim strText, book_name As String
Dim strL, i, endP As Integer
strText = ListBox1.text
strL = Len(strText)
For i = 1 To strL
If Mid(strText, i, 1) = vbTab Then endP = i
Next i
strText = Right(strText, strL - endP)
'マクロ名からVBEへ移動
'UserForm3.Hide
book_name = ActiveWorkbook.Name
Workbooks(book_name).Activate
Application.Goto Reference:=strText
End Sub
ボタン2(終了)が押されたら
Private Sub CommandButton2_Click()
Unload Me
End Sub
ボタン3(選択モジュールをTEXT出力)が押されたら
Private Sub CommandButton3_Click()
'リストボックスで取得したモジュールないコードをTEXT出力
'
On Error Resume Next
Dim strText, book_name, saveD, moduleName As String
Dim strL, i, endP As Integer
Dim MyCodeModule As Object
'選択文字列を取得
strText = ListBox1.text 'モジュール名+vbTab+プロシージャ名
strL = Len(strText)
For i = 1 To strL
If Mid(strText, i, 1) = vbTab Then endP = i: Exit For
Next i
'vbTabの位置から左側を取得(モジュール名)-1はvbTABを含まないように
moduleName = Left(strText, endP - 1)
'モジュール名からモジュール内のコードをTEXT出力
Open ActiveWorkbook.Name & moduleName & ".txt" For Output As #1
Set MyCodeModule = ActiveWorkbook.VBProject.VBComponents(moduleName).CodeModule
If MyCodeModule = "" Then MsgBox "モジュールを取得できませんでした。": Exit Sub
For i = 1 To MyCodeModule.CountOfLines
saveD = saveD & MyCodeModule.Lines(i, 1) & vbCrLf
'Debug.Print saveD
Next i
Print #1, saveD
Close #1
Set MyCodeModule = Nothing
MsgBox "完了"
'ファイルを開く
Dim WSH
Dim URL As String
Set WSH = CreateObject("Wscript.Shell")
WSH.Run ActiveWorkbook.Name & moduleName & ".txt"
Set WSH = Nothing
'エクスプローラを開く
Dim myFolder As String
'フォルダの設定
myFolder = ActiveWorkbook.Path
'myFolder = "D:\bk\office\"
'エクスプローラの起動(Windows2000 C:\WINNT WindowsXP C:\Windows)
Shell "C:\WINNT\Explorer.exe " & myFolder, vbNormalFocus
End Sub
コメント 0