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,禁用屏幕更新,但这似乎也不是解决方案。我错过了什么?
编辑:
我进一步尝试但没有成功:
- 在编辑器中禁用语法检查
- 错误继续下一步
- Err.Clear
- newDoc.EnableEvents = False(在执行@Алексей-Р 建议后)
- 不包括删除 .VBProject.VBComponents 名称“ThisDocument”
此外,显式编译修改后的文件代码预计不会引发任何错误。是否有任何我不知道的编辑器设置?
我试着自己回答一下,至少这解决了这个问题:
我用
打开文件
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
此解决方案打开一个新的空白文档并复制粘贴内容,而首先没有宏。之后,我继续按照问题
的初始片段重写模块
不确定为什么它可以使用我提供的代码为 @АлексейР 工作。还是谢谢大家的关心!
即使在查看了所有类似的措辞问题和几个搜索引擎结果后,我也没有找到任何答案。
我复制当前的 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,禁用屏幕更新,但这似乎也不是解决方案。我错过了什么?
编辑: 我进一步尝试但没有成功:
- 在编辑器中禁用语法检查
- 错误继续下一步
- Err.Clear
- newDoc.EnableEvents = False(在执行@Алексей-Р 建议后)
- 不包括删除 .VBProject.VBComponents 名称“ThisDocument”
此外,显式编译修改后的文件代码预计不会引发任何错误。是否有任何我不知道的编辑器设置?
我试着自己回答一下,至少这解决了这个问题:
我用
打开文件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
此解决方案打开一个新的空白文档并复制粘贴内容,而首先没有宏。之后,我继续按照问题
的初始片段重写模块不确定为什么它可以使用我提供的代码为 @АлексейР 工作。还是谢谢大家的关心!