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

我有一个电子表格中的Excel文件列表。 我想遍历它们并向每个添加一个工作表事件。 保存它，closures它并转到下一个。 问题是，当我重新打开（手动）工作簿的代码已经消失。

在每个循环内：

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代码在工作簿中并且工作。 我可以手动保存并closures文件，代码依然存在。 我在xl.save和xl.close之间添加了一个断点，并创build了一个文件的副本。 代码完成后，都没有改变。 我试过使用xl.saveas和xl.close SaveChanges：= True。 所有结果都一样。

我正在使用Excel 2013，我已经告诉Excel信任对VBA对象模型的访问。 我试过使用XLS文件和XLSM文件。 很明显，XLSX将无法正常工作。

Answer 1

这里是一些示例代码，它是在Excel 2010上为我工作的。我对您的示例代码所作的更改是：

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

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

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

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

除此之外，我的版本是非常相似的你的。 我认为这是wb.Saved = False行，就是肮脏的标志。 我试图在VBProject本身上使用SaveAs方法，认为它与在VBA编辑器本身中的保存button相同。 但是，这只是无益的错误。

以下是示例代码：

 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