vba - 以编程方式添加工作簿事件并保存

Question

我的电子表格中有一个 Excel 文件列表。我想循环遍历它们并向每个添加一个工作表事件。保存它，关闭它并继续下一步。问题是，当我重新打开(手动)工作簿时，代码消失了。

在 foreach 循环内:

Set xl = Workbooks.Open(filepath)
addCode xl 'subroutine to add code
xl.Save
xl.Close SaveChanges:=False

addCode 子例程是:

Sub addCode(book As Excel.Workbook)
     acsh = book.ActiveSheet.CodeName
     startline = book.VBProject.VBComponents(acsh).CodeModule.CreateEventProc("SelectionChange", "Worksheet") + 1
     book.VBProject.VBComponents(acsh).CodeModule.InsertLines startline, codetoadd
End Sub

如果我注释掉 xl.Close 代码就在工作簿中并且可以工作。我可以手动保存并关闭文件，代码仍然保留。我在 xl.save 和 xl.close 之间添加了一个断点，并制作了文件的副本。代码完成后也没有进行任何更改。我尝试过使用 xl.saveas 和 xl.close SaveChanges:=True 。所有结果都相同。

我使用的是 Excel 2013，我已告诉 Excel 信任对 VBA 对象模型的访问。我尝试过使用 XLS 文件和 XLSM 文件。显然 XLSX 不起作用。

Answer 1

这里是一些在 Excel 2010 上适用的示例代码。我对示例代码所做的更改是:

• 使用 .xlsm 作为目标工作簿 - 我知道您说过您已经这样做了。

• 在 AddCode 子项中引用特定工作表，而不是从 ActiveSheet 中获取工作表名称。

• 根据 Ralph 的评论设置工作簿脏状态

• 关闭目标工作簿时不要设置 SaveChanges 标志

除此之外，我的版本与你的非常相似。我认为是 wb.Saved = False 行起到了作用，即脏标志。我尝试在 VBProject 本身上使用 SaveAs 方法，认为这与在 VBA 编辑器本身中单击“保存”按钮相同。然而，这只会产生无用的错误。

这是示例代码:

Option Explicit

Sub Test()

    Dim wbTarget As Workbook
    Dim strCode As String

    ' get target workbook
    Set wbTarget = Workbooks.Open("\\server\path\Book3.xlsm")

    ' test setting code to worksheet change
    strCode = "Debug.Print ""Sheet selection changed to: "" & Target.Address"
    AddWorksheetChangeCode wbTarget, "Sheet1", strCode

    ' test saving the target workbook
    With wbTarget
        ' set book to dirty to force the save
        .Saved = False
        .Save
        .Close
    End With

End Sub

Sub AddWorksheetChangeCode(ByRef wb As Workbook, strWorksheetName As String, strCode As String)

    Dim intInsertLine As Integer

    ' create stub for event and get line to insert
    intInsertLine = wb.VBProject.VBComponents(strWorksheetName).CodeModule.CreateEventProc("SelectionChange", "Worksheet") + 1

    ' add event logic
    wb.VBProject.VBComponents(strWorksheetName).CodeModule.InsertLines intInsertLine, strCode

End Sub