我想将一个Excel工作表及其所有VBA代码从一个工作簿复制到另一个工作簿。每次尝试“移动或复制图纸”时,图纸副本都会被复制,但是没有VBA模块会转移到新工作簿中。有办法吗?
答案 0 :(得分:0)
我过去曾经使用过类似的方法。你的旅费可能会改变。需要对其进行调整以引用两个不同的工作簿。尚未通过最新的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