VBA テキスト化 備忘 4H070Z

他者の投稿から引用したものを自分用に残す。

Public Sub ExportModules()
'現在のワークブックのモジュールをエクスポートする
Dim targetModule As VBComponent
Dim outputPath As String
Dim fileExt As String
outputPath = ActiveWorkbook.Path
For Each targetModule In ActiveWorkbook.VBProject.VBComponents
fileExt = GetExtFromModuleType(targetModule.Type)
If fileExt <> "" Then
ExportModuleWithExt targetModule, outputPath, fileExt
Debug.Print "Save " & targetModule.Name
End If
Next
End Sub

Private Function GetExtFromModuleType(aType As Integer) As String
'指定されたモジュール・タイプに対応する拡張子を返す
Select Case aType
Case vbext_ct_StdModule
GetExtFromModuleType = "bas"
Case vbext_ct_ClassModule, vbext_ct_Document
GetExtFromModuleType = "cls"
Case vbext_ct_MSForm
GetExtFromModuleType = "frm"
End Select
End Function

Private Sub ExportModuleWithExt(aModule As VBComponent, Path As String, Ext As String)
'指定されたモジュールをエクスポートする
Dim filePath As String
Dim fileName As String
'filePath = Path & "" & aModule.Name & "." & Ext
fileName = ActiveWorkbook.Name
filePath = Path & "" & fileName & "-" & aModule.Name & "." & Ext
aModule.Export filePath
End Sub
応用部分
複数のファイルに対して実行するための部分です。

Sub フォルダ内モジュール一括エクスポート()
thisfn = ActiveWorkbook.Name
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "フォルダを選択"
.AllowMultiSelect = False
If .Show = -1 Then
targetdir = .SelectedItems(1)
Else
Exit Sub
End If
End With
targetfn = Dir(targetdir & "", vbNormal)
Do Until targetfn = ""
If thisfn <> targetfn Then
Call モジュールをエクスポート(thisfn, targetfn)
End If
targetfn = Dir
Loop
MsgBox "処理が終わりました。"
End Sub

Sub モジュールをエクスポート(thisfilename, targetfilename)
Workbooks.Open fileName:=targetfilename
Application.Run thisfilename & "!ExportModules"
ActiveWorkbook.Close
End Sub

"開発コード:4H070Z"