compile error: end sub expected on ActiveDocument.Close after .VBComponents("thisDocument").CodeModule.AddFromFile

compile error: end sub expected on ActiveDocument.Close after .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.SaveAs2 之后关闭 ActiveDocument 时出现编译错误。虽然没有关闭文件我没有得到任何错误,但这对工作环境来说不是很好,弄乱了屏幕。

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

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

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

我试着自己回答一下,至少这解决了这个问题:

我用

打开文件
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

此解决方案打开一个新的空白文档并复制粘贴内容,而首先没有宏。之后,我继续按照问题

的初始片段重写模块

不确定为什么它可以使用我提供的代码为 @АлексейР 工作。还是谢谢大家的关心!