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

Question

我在电子表格中有一个 Excel 文件列表。我想遍历它们并为每个添加一个工作表事件。保存它，关闭它，然后继续下一个。问题是当我（手动）重新打开工作簿时，代码消失了。

for each 循环内部：

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