VBA 將模塊從一個 Excel 工作簿復制到另一個工作簿

Question

我正在嘗試使用 VBA 將模塊從一個 Excel 工作簿復制到另一個。

我的代碼：

'Copy Macros

Dim comp As Object
Set comp = ThisWorkbook.VBProject.VBComponents("Module2")
Set Target = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm").VBProject.VBComponents.Add(1)

由於某種原因，這復制了模塊，但沒有復制里面的VBA代碼，為什么？

請有人告訴我我哪里出錯了？

謝謝

Answer 1

下面的Sub CopyModule ，接收 3 個參數：

1.源工作簿（作為Workbook ）。

2.要復制的模塊名稱（作為String ）。

3.目標工作簿（如Workbook ）。

復制模塊代碼

Public Sub CopyModule(SourceWB As Workbook, strModuleName As String, TargetWB As Workbook)

    ' Description:  copies a module from one workbook to another
    ' example: CopyModule Workbooks(ThisWorkbook), "Module2",
    '          Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")
    ' Notes:   If Module to be copied already exists, it is removed first,
    '          and afterwards copied

    Dim strFolder                       As String
    Dim strTempFile                     As String
    Dim FName                           As String

    If Trim(strModuleName) = vbNullString Then
        Exit Sub
    End If

    If TargetWB Is Nothing Then
        MsgBox "Error: Target Workbook " & TargetWB.Name & " doesn't exist (or closed)", vbCritical
        Exit Sub
    End If

    strFolder = SourceWB.Path
    If Len(strFolder) = 0 Then strFolder = CurDir

    ' create temp file and copy "Module2" into it
    strFolder = strFolder & "\"
    strTempFile = strFolder & "~tmpexport.bas"

    On Error Resume Next
    FName = Environ("Temp") & "\" & strModuleName & ".bas"
    If Dir(FName, vbNormal + vbHidden + vbSystem) <> vbNullString Then
        Err.Clear
        Kill FName
        If Err.Number <> 0 Then
            MsgBox "Error copying module " & strModuleName & "  from Workbook " & SourceWB.Name & " to Workbook " & TargetWB.Name, vbInformation
            Exit Sub
        End If
    End If

    ' remove "Module2" if already exits in destination workbook
    With TargetWB.VBProject.VBComponents
        .Remove .Item(strModuleName)
    End With

    ' copy "Module2" from temp file to destination workbook
    SourceWB.VBProject.VBComponents(strModuleName).Export strTempFile
    TargetWB.VBProject.VBComponents.Import strTempFile

    Kill strTempFile
    On Error GoTo 0

End Sub

---

主要Sub代碼（用於使用 Post 數據運行此代碼）：

Option Explicit

Public Sub Main()

Dim WB1 As Workbook
Dim WB2 As Workbook

Set WB1 = ThisWorkbook
Set WB2 = Workbooks("Food Specials Rolling Depot Memo 46 - 01.xlsm")

Call CopyModule(WB1, "Module2", WB2)

End Sub

Answer 2

Chris Melville 編寫的神奇代碼，非常感謝，只是我所做的一些小補充並添加了一些評論。

請確保在運行此宏之前已完成以下操作。

• VB 編輯器 > 工具 > 參考 >（檢查）Microsoft Visual Basic for Applications Extensibility 5.3

• 文件 -> 選項 -> 信任中心 -> 信任中心設置 -> 宏設置 -> 對 VBA 項目對象模型的信任訪問。

完成上述操作后，將下面的代碼復制並粘貼到源文件中

Sub CopyMacrosToExistingWorkbook()
'Copy this VBA Code in SourceMacroModule, & run this macro in Destination workbook by pressing Alt+F8, the whole module gets copied to destination File.
    Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
    Set SourceVBProject = ThisWorkbook.VBProject
    Dim NewWb As Workbook
    Set NewWb = ActiveWorkbook ' Or whatever workbook object you have for the destination
    Set DestinationVBProject = NewWb.VBProject
    '
    Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
    Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
    ' Add a new module to the destination project
    Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
    '
    With SourceModule
        DestinationModule.AddFromString .Lines(1, .CountOfLines)
    End With
End Sub

現在在目標文件中運行“CopyMacrosToExistingWorkbook”宏，您將看到源文件宏復制到目標文件。

Answer 3

實際上，您根本不需要將任何內容保存到臨時文件中。 您可以使用目標模塊的.AddFromString方法來添加源的字符串值。 試試下面的代碼：

Sub CopyModule()
    Dim SourceVBProject As VBIDE.VBProject, DestinationVBProject As VBIDE.VBProject
    Set SourceVBProject = ThisWorkbook.VBProject
    Dim NewWb As Workbook
    Set NewWb = Workbooks.Add ' Or whatever workbook object you have for the destination
    Set DestinationVBProject = NewWb.VBProject
    '
    Dim SourceModule As VBIDE.CodeModule, DestinationModule As VBIDE.CodeModule
    Set SourceModule = SourceVBProject.VBComponents("Module1").CodeModule ' Change "Module1" to the relevsant source module
    ' Add a new module to the destination project
    Set DestinationModule = DestinationVBProject.VBComponents.Add(vbext_ct_StdModule).CodeModule
    '
    With SourceModule
        DestinationModule.AddFromString .Lines(1, .CountOfLines)
    End With
End Sub

應該不言自明！ .AddFomString方法只需要一個字符串變量。 所以為了得到它，我們使用源模塊的 .Lines 屬性。 第一個參數 ( 1 ) 是起始行，第二個參數是結束行號。 在本例中，我們需要所有行，因此我們使用.CountOfLines屬性。

Answer 4

Shai Rado 的導出/導入方法的優點是可以拆分它們，即將源工作簿中的模塊作為一個步驟導出，然后將它們導入到多個目標文件中！

Answer 5

我在獲得以前的答案時遇到了很多麻煩，所以我想我會發布我的解決方案。 此函數用於以編程方式將模塊從源工作簿復制到新創建的工作簿，該工作簿也是通過調用 worksheet.copy 以編程方式創建的。 將工作表復制到新工作簿時不會發生的是工作表所依賴的宏的傳輸。 此過程遍歷源工作簿中的所有模塊並將它們復制到新的模塊中。 更重要的是，它實際上在 Excel 2016 中對我有用。

Sub CopyModules(wbSource As Workbook, wbTarget As Workbook)
   Dim vbcompSource As VBComponent, vbcompTarget As VBComponent
   Dim sText As String, nType As Long
   For Each vbcompSource In wbSource.VBProject.VBComponents
      nType = vbcompSource.Type
      If nType < 100 Then  '100=vbext_ct_Document -- the only module type we would not want to copy
         Set vbcompTarget = wbTarget.VBProject.VBComponents.Add(nType)
         sText = vbcompSource.CodeModule.Lines(1, vbcompSource.CodeModule.CountOfLines)
         vbcompTarget.CodeModule.AddFromString (sText)
         vbcompTarget.Name = vbcompSource.Name
      End If
   Next vbcompSource
End Sub

該函數應該盡可能簡單並且不言自明。