Question

我创建了一些代码，其中一个要求是复制某些工作表，模块和按钮以将这些模块引用到新工作簿。

我面临两个问题：

1）在尝试各种各样的事情时，我能够复制工作表和模块。但是，问题是当我将模块按钮复制到新工作表时，它仍然引用原始文件而不是已创建的新文件。

2）当按钮删除命令运行时，它会删除现有工作簿中的按钮并在现有工作簿中插入新按钮。

我可以理解，在某个地方，我没有回到原始文件，但无法确定在何处以及如何转到新文件来执行代码。

复制文件，模块和按钮的代码如下所示。

Dlltest

Answer 1

您的问题源于您没有正确识别工作簿的事实。使用ThisWorkbook将始终表示运行代码的工作簿。使用ActiveWorkbook将始终表示代码执行中当时处于活动状态的工作簿。虽然有完全合法的时间和地点使用它，但它通常是糟糕的做法，尤其是ActiveWorkbook（和ActiveSheet就此而言。）

我已经使用完整的注释重构了您的代码来说明这一点，并清理了其中一些其他与语法相关的内容。

Sub Workbook_Open()

Const MODULE_NAME    As String = "DataValidityCheck"         ' Name of the module to transfer
Const TEMPFILE       As String = "c:\DataValidityCheck.bas" ' temp textfile

'qualify main workbook
Dim wbkMain As Workbook
Set wbkMain = ThisWorkbook
'export desired module
With wbkMain

    .VBProject.VBComponents(MODULE_NAME).Export TEMPFILE

    'copy out sheets
    .Sheets(Array("Sheet1", "Sheet2")).Copy

End With

'qualify new workbook
Dim WBK As Workbook
Set WBK = ActiveWorkbook 'this is one of only a few times its required to use 'ActiveWorkbook'

'work directly with new workbook
With WBK

    'Copy Module to New Workbook
    .VBProject.VBComponents.Import TEMPFILE
    Kill TEMPFILE

    'delete bad names
    Dim nm As Name
    For Each nm In .Names
        If InStr(1, nm.RefersTo, "#REF!") Then nm.Delete
    Next

    'Delete every shape in the Shapes collection
    With .Sheets(1) 'change to 2 if you need sheet 2

        Dim myshape As Shape
        For Each myshape In .Shapes 'change to 2 if you need sheet 2
            myshape.Delete
        Next myshape

        .Buttons.Add(2538, 4.5, 71.25, 14.25).Select

        With Selection 'should really set this to a variable as well, but I didn't feel like looking the right syntax
            .Caption = "Validate Data" 'change the name of the button accordingly
            .OnAction = "msg" 'Workbook_Open if need be
        End With

    End With

    'finally save the new workbook
    Dim filename4 As String, strFilename4 As String
    strFilename4 = "\Work Data " & Format(Now(), "ddmmyy hhmmss")
    filename4 = ActiveWorkbook.Path & strFilename4 & ".xlsm"

    .SaveAs Filename:=filename4, FileFormat:=xlOpenXMLWorkbookMacroEnabled, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False

    .Close True 'don't need since you just saved, but why not

End With

Application.CutCopyMode = False

End Sub

将工作表，代码和按钮复制到新文件

1 个答案: