多くのワークシートにコピーする必要がある VBA コードがあります (これはイベント処理であるため、モジュールではなくシートに配置されています)。
質問: 変更する必要があるすべてのワークブックを選択し、選択したすべてのワークブックのすべてのシートにコードを自動的に書き込むマクロを作成することはできますか?
質問する
14667 次
3 に答える
5
あるプロジェクトから別のプロジェクトにモジュールを直接コピーする方法はありません。このタスクを実行するには、ソース VBProject からモジュールをエクスポートし、そのファイルを宛先 VBProject にインポートする必要があります。以下のコードはこれを行います。
関数宣言は次のとおりです。
Function CopyModule(ModuleName As String, _
FromVBProject As VBIDE.VBProject, _
ToVBProject As VBIDE.VBProject, _
OverwriteExisting As Boolean) As Boolean
ModuleNameあるプロジェクトから別のプロジェクトにコピーするモジュールの名前です。
FromVBProjectVBProjectコピーするモジュールを含む です。これがソースVBProjectです。
ToVBProjectモジュールのVBProjectコピー先です。これが目的地VBProjectです。
OverwriteExistingModuleNameに既に存在する場合の対処方法を示しますToVBProject。これが存在する場合True、既存のVBComponentは から削除されますToVBProject。これが存在Falseし、 がVBComponent既に存在する場合、関数は何もせずに を返しますFalse。
True成功したFalse場合、またはエラーが発生した場合、関数は戻ります。False次のいずれかが true の場合、関数は戻ります。
FromVBProject is nothing.
ToVBProject is nothing.
ModuleName is blank.
FromVBProject is locked.
ToVBProject is locked.
ModuleName does not exist in FromVBProject.
ModuleName exists in ToVBProject and OverwriteExisting is False.
完全なコードを以下に示します。
Function CopyModule(ModuleName As String, _
FromVBProject As VBIDE.VBProject, _
ToVBProject As VBIDE.VBProject, _
OverwriteExisting As Boolean) As Boolean
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' CopyModule
' This function copies a module from one VBProject to
' another. It returns True if successful or False
' if an error occurs.
'
' Parameters:
' --------------------------------
' FromVBProject The VBProject that contains the module
' to be copied.
'
' ToVBProject The VBProject into which the module is
' to be copied.
'
' ModuleName The name of the module to copy.
'
' OverwriteExisting If True, the VBComponent named ModuleName
' in ToVBProject will be removed before
' importing the module. If False and
' a VBComponent named ModuleName exists
' in ToVBProject, the code will return
' False.
'
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Dim VBComp As VBIDE.VBComponent
Dim FName As String
Dim CompName As String
Dim S As String
Dim SlashPos As Long
Dim ExtPos As Long
Dim TempVBComp As VBIDE.VBComponent
'''''''''''''''''''''''''''''''''''''''''''''
' Do some housekeeping validation.
'''''''''''''''''''''''''''''''''''''''''''''
If FromVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If Trim(ModuleName) = vbNullString Then
CopyModule = False
Exit Function
End If
If ToVBProject Is Nothing Then
CopyModule = False
Exit Function
End If
If FromVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
If ToVBProject.Protection = vbext_pp_locked Then
CopyModule = False
Exit Function
End If
On Error Resume Next
Set VBComp = FromVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
' FName is the name of the temporary file to be
' used in the Export/Import code.
''''''''''''''''''''''''''''''''''''''''''''''''''''
FName = Environ("Temp") & "\" & ModuleName & ".bas"
If OverwriteExisting = True Then
''''''''''''''''''''''''''''''''''''''
' If OverwriteExisting is True, Kill
' the existing temp file and remove
' the existing VBComponent from the
' ToVBProject.
''''''''''''''''''''''''''''''''''''''
If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
Err.Clear
Kill FName
If Err.Number <> 0 Then
CopyModule = False
Exit Function
End If
End If
With ToVBProject.VBComponents
.Remove .Item(ModuleName)
End With
Else
'''''''''''''''''''''''''''''''''''''''''
' OverwriteExisting is False. If there is
' already a VBComponent named ModuleName,
' exit with a return code of False.
''''''''''''''''''''''''''''''''''''''''''
Err.Clear
Set VBComp = ToVBProject.VBComponents(ModuleName)
If Err.Number <> 0 Then
If Err.Number = 9 Then
' module doesn't exist. ignore error.
Else
' other error. get out with return value of False
CopyModule = False
Exit Function
End If
End If
End If
''''''''''''''''''''''''''''''''''''''''''''''''''''
' Do the Export and Import operation using FName
' and then Kill FName.
''''''''''''''''''''''''''''''''''''''''''''''''''''
FromVBProject.VBComponents(ModuleName).Export Filename:=FName
'''''''''''''''''''''''''''''''''''''
' Extract the module name from the
' export file name.
'''''''''''''''''''''''''''''''''''''
SlashPos = InStrRev(FName, "\")
ExtPos = InStrRev(FName, ".")
CompName = Mid(FName, SlashPos + 1, ExtPos - SlashPos - 1)
''''''''''''''''''''''''''''''''''''''''''''''
' Document modules (SheetX and ThisWorkbook)
' cannot be removed. So, if we are working with
' a document object, delete all code in that
' component and add the lines of FName
' back in to the module.
''''''''''''''''''''''''''''''''''''''''''''''
Set VBComp = Nothing
Set VBComp = ToVBProject.VBComponents(CompName)
If VBComp Is Nothing Then
ToVBProject.VBComponents.Import Filename:=FName
Else
If VBComp.Type = vbext_ct_Document Then
' VBComp is destination module
Set TempVBComp = ToVBProject.VBComponents.Import(FName)
' TempVBComp is source module
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
S = TempVBComp.CodeModule.Lines(1, TempVBComp.CodeModule.CountOfLines)
.InsertLines 1, S
End With
On Error GoTo 0
ToVBProject.VBComponents.Remove TempVBComp
End If
End If
Kill FName
CopyModule = True
End Function
于 2014-11-24T10:50:16.767 に答える
1
この種のタスクを実行するには、VBComponents を調べる必要があります。
まず、「Microsoft Visual Basic for Applications Extensibility」というリファレンスを有効にする必要があります。
次のコードを試してください。
Sub Test_InsertCode()
Dim Commands As String
Commands = Chr(13) & _
"Private Sub TestNewCode()" & Chr(13) & _
" MsgBox ""You Win !!""" & Chr(13) & _
"End Sub"
Dim VBComps As VBComponents
Set VBComps = ThisWorkbook.VBProject.VBComponents
Dim VBComp As VBComponent
Dim VBCodeMod As CodeModule
Dim oSheet As Worksheet
For Each oSheet In ThisWorkbook.Worksheets
Set VBComp = VBComps(oSheet.CodeName)
Set VBCodeMod = VBComp.CodeModule
InsertCode VBCodeMod, Commands
Next oSheet
'Here's a quick example of how to insert code in a new Module
Set VBComp = VBComps.Add(vbext_ct_StdModule)
InsertCode VBComp.CodeModule, Commands
End Sub
Private Function InsertCode(VBCodeMod As CodeModule, Commands As String)
Dim LineNum As Long
With VBCodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, Commands
End With
End Function
注意してください。ブレーク モードで実行すると (または 1 行ずつ実行しますか?)、コードがコピーされた直後にバグが生成されます。一度にすべて実行する必要があります..
このコードは Excel 2003 で動作します。それ以降のバージョンで実行すると、セキュリティ上の問題が発生する可能性があります。
于 2012-10-03T15:42:47.217 に答える
0
これは、ワークシートのイベント部分を解決しませんが、モジュールをあるワークブックから別のワークブックに移動するための簡単なソリューションです。
注 - 上記のように、「Microsoft Visual Basic for Applications Extensibility」参照を有効にする必要があります。
要するに、コードは機能します (すべてのハウスキーピング検証なしで)。明らかに、より洗練されたエラー防止/処理を行うことができますが、これが基本です。この関数は、モジュールを FromVBProject からファイル ディレクトリにエクスポートしてから、ToVBProject にインポートします。
Function CopyModule (ModuleName as String, FromVBProject as VBIDE.VBProject, _
ToVBProject as VBIDE.VBProject, _
FileLocation as String) as Boolean
Dim fileDirectory as String
fileDirectory = filelocation & ModuleName & ".bas"
FromVBProject.VBComponents.Item(ModuleName).Export fileDirectory
ToVBProject.Import fileDirectory
Kill fileDirectory
CopyModule = True
End Function
Sub CopyModuleToOtherWorkbook()
Dim destinationWorkbook as Workbook
Set destinationWorkbook = Workbooks("destiationWorkbook.xlsm")
CopyModule "TestModule", ThisWorkbook.VBProject, destinationWorkbook.VBProject, "C:\my documents\macros\"
'Assuming you want to save the workbook you just copied the module to
destinationWorkbook.SaveAs C:\my documents\macros\ & desintationWorkbook.Name, xlOpenXMLWorkbookMacroEnabled
End sub
于 2015-02-06T00:09:12.227 に答える