时间戳

首页 > 解决方案 > 将工作表及其代码复制到另一个工作簿中

excel - 将工作表及其代码复制到另一个工作簿中

问题描述

我想将一个工作簿中的 Excel 工作表及其所有 VBA 代码复制到另一个工作簿中。每次我尝试“移动或复制工作表”时，工作表都会复制，但没有一个 VBA 模块会转移到新工作簿中。有没有办法做到这一点？

标签： excelvbacopy-pasteworksheet

解决方案

我过去曾使用过类似的东西。你的旅费可能会改变。需要对其进行调整以参考两个不同的工作簿。尚未使用最近的 MSOffice 对其进行测试。我不知道它是否处理工作表对象中的代码。

Option Explicit
    Dim sExportLocation As String
    sExportLocation = "C:\myTempExport\" 'Do not forget the closing back slash! ie: C:\Temp\

Public Sub DoExportImport
    ExportTheModules
    ImportDatabaseObjects
End Sub    

Public Sub ExportTheModules
     '===============================================================================
     ' Name:    DocDatabase Purpose: Documents the database to a series of text files
     ' Author:  Arvin Meyer       ' Date:    June 02, 1999
     ' Comment: Uses the undocumented [Application.SaveAsText] syntax
     '          To reload use the syntax [Application.LoadFromText]
     '      Modified to set a reference to DAO 8/22/2005
     '===============================================================================
    Dim dbs As DAO.Database,  cnt As DAO.Container,  doc As DAO.Document

    Set cnt = dbs.Containers("Modules")
    For Each doc In cnt.Documents
        Application.SaveAsText acModule, doc.Name, sExportLocation & "Mods_" & doc.Name & ".txt"
    Next doc
End Sub

Public Sub ImportDatabaseObjects()
    On Error GoTo Err_ImportDatabaseObjects
    Dim db As Database      'Dim db As DAO.Database
    Dim td As TableDef, d As Document, c As Container  
    Set db = CurrentDb()

    Dim sFN As String, sName As String, sList() As Variant
    sList = Array("Module_", acModule)     ' Array("Module_", acModule, "Form_", acForm, "Query_", acQuery)
    sFN = Dir(sExportLocation & sList(0) & "*.txt")
    Do While sFN <> ""
        sName = Replace(sFN, sList(0), "")
        sName = Replace(sName, ".txt", "")
        Debug.Print sFN, , sName
        Application.LoadFromText sList(1), sName, sExportLocation & sFN
        sFN = Dir
    Loop

    Exit Sub

Err_ImportDatabaseObjects:
    MsgBox Err.Number & " - " & Err.Description
    Set c = Nothing
    db.Close
    Set db = Nothing    
End Sub

推荐阅读