编译错误: 在活动文档上应结束子。在 之后关闭。VBComponents( "thisDocument" ).CodeModule.AddFromFile



即使在浏览了所有类似的短语问题和几个搜索引擎结果后,我也没有找到任何答案。

我复制当前的word文档,通过删除以前的模块来更改代码库,并通过从文件中添加来重写ThisDocument组件。对于上下文,但很可能是可跳过的:

Public Sub DOCMPublish()
'...msoFileDialogSaveAs...and then...'
Application.Documents.Add ThisDocument.FullName
On Error Resume Next

' unlink fields and finalize content to avoid updates within the archived documents
Dim oFld As field
For Each oFld In ActiveDocument.Fields
oFld.Unlink
Next

' rewrite macros and unload modules
On Error Resume Next
Dim Element As Object
For Each Element In ActiveDocument.VBProject.VBComponents
ActiveDocument.VBProject.VBComponents.Remove Element
Next
rewriteMain ActiveDocument, "ThisDocument", ThisDocument.path & "Document_Public_DOCM.vba"
' protect content
ActiveDocument.Protect wdAllowOnlyFormFields, Password:="LoremIpsum"

' msoFileDialogSaveAs does not support filetypes, hence forcing extension
DOCMFile = fileSaveName.SelectedItems(1)
DOCMFile = Replace(DOCMFile, ".doc", ".docm")
DOCMFile = Replace(DOCMFile, ".docmx", ".docm")

' the next line saves the copy to your location and name
ActiveDocument.SaveAs2 filename:=DOCMFile, FileFormat:=wdFormatXMLDocumentMacroEnabled
' next line closes the copy leaving you with the original document
ActiveDocument.Close
End Sub

在过去的几年里,这个潜艇工作得很好:

Sub rewriteMain(ByRef Workument, ByVal Module, ByVal Source)
'delete code from ThisDocument/ThisWorkbook
Workument.VBProject.VBComponents.Item(1).CodeModule.DeleteLines 1, Workument.VBProject.VBComponents.Item(1).CodeModule.CountOfLines
'rewrite from file
With Workument.VBProject
.VBComponents(Module).CodeModule.AddFromFile Source
End With
'delete module
Workument.VBProject.VBComponents.Remove Workument.VBProject.VBComponents("Rewrite")
End Sub

要导入的Document_Public_DOCM.vba的内容是

Option Explicit
Private Sub Document_Close()
ThisDocument.Saved = True
End Sub
Private Sub Document_ContentControlOnExit(ByVal ContentControl As ContentControl, Cancel As Boolean)
Dim cc As ContentControl
For Each cc In ThisDocument.ContentControls
'checkboxes have no type attribute to check against, therefore the need of _
error handling on checked-property that is checkbox-only in this usecase
On Error Resume Next
ThisDocument.Bookmarks("text" & cc.Tag).Range.Font.Hidden = Not cc.Checked
ThisDocument.Bookmarks("notext" & cc.Tag).Range.Font.Hidden = cc.Checked
Next
End Sub

我看这里没有问题,修改和保存的文件以后也没有抱怨。但与此同时,我在导入后关闭ActiveDocument和ActiveDocument.SaveAs2时遇到了编译错误。不过,如果不关闭文件,我不会出错,但这对工作环境不好,会扰乱屏幕。

单词经常崩溃,有时只会导致状态丢失。我还尝试了编码为utf-8和iso8859-1,禁用了屏幕更新,但这似乎不是解决方案。我错过了什么?

编辑:我进一步尝试但没有成功:

  • 在编辑器中禁用语法检查
  • 出现错误时继续下一步
  • 错误清除
  • newDoc.EnableEvents=False(在执行@Алексей-Р建议后(
  • 不包括删除.VBProject.VB组件名称";本文档">

此外,显式编译修改后的文件代码不会引发任何错误。有没有我不知道的编辑器设置?

我试着自己回答,

至少这解决了这种情况下的问题:

我用打开文件

Set newDOC = Documents.Add(ThisDocument.FullName, True, wdNewBlankDocument, False)

我只能假设,在一个新的空白文档中打开文件而不显示它可能会阻止代码的执行,从而在运行时替换问题。

编辑:它一开始起作用,后来就没用了。还是不知道为什么。以下内容现在看来是防故障的:

Set newDOC = Documents.Add("", True, wdNewBlankDocument, False)
ThisDocument.Content.Copy
dim rng
Set rng = newDoc.Content
rng.Collapse Direction:=wdCollapseEnd
rng.Paste
'clear clipboard, otherwise an annoying msg popy up everytime because huge content is left there from copying
Dim clscb As New DataObject 'object to use the clipboard
clscb.SetText text:=Empty
clscb.PutInClipboard 'put void into clipboard

此解决方案打开一个新的空白文档并复制内容,而不首先包含宏。之后,我继续重写模块,如问题的初始片段所示

但我不知道为什么用我提供的代码对@АлексейР有效。谢谢你的关心!

最新更新