在27页文档上运行宏时，Word内存不足

Question

这篇文章是在微软问答论坛上交叉发布的。

下面的宏用于保护有问题的word文档。当它在较小的文档(4-10页)上运行时，它工作得很好，但我们有一个更大的27页文档(6000字)，似乎吸收了所有的内存!我运行了它，结果这个词在我身上冻结了。

下面是一个OneDrive可复制示例的链接:https://1drv.ms/w/s!AgPO3BotYSt7iHvafHts2HyF2OjB?e=HSOI57

不确定通过OneDrive访问时格式是否保持，但单击复选框时显示X。

"您将如何满足推荐的描述"后面是一个文本字段，以便用户可以输入文本。"负责任的团队"one_answers"你不同意的理由"也是一样的:

宏运行后，整个文档应该被锁定，除了上面描述的红色文本和格式。

是否有任何方式来适应宏，以节省一些内存，允许它运行时使用较大的文件?

宏:

Sub Lock_Teammate_DraftReports_mp()
Selection.HomeKey wdStory
Selection.Find.ClearFormatting
Selection.Find.Font.ColorIndex = wdRed
With Selection.Find
Do While .Execute(FindText:="", Forward:=True, MatchWildcards:=False, Wrap:=wdFindStop) = True
Selection.Editors.Add wdEditorEveryone
Selection.Collapse wdCollapseEnd
Loop
End With
ActiveDocument.Protect Password:="example123", NoReset:=False, Type:=wdAllowOnlyReading, 
UseIRM:=False, EnforceStyleLock:=False
End Sub

Answer 1

您的问题很可能与您的代码所做的所有选择有关，这既低效又容易导致大量滚动和屏幕闪烁。试一试:

Sub Lock_Teammate_DraftReports_mp()
Application.ScreenUpdating = False
Dim i As Long
With ActiveDocument
With .Range
With .Find
.ClearFormatting
.Font.ColorIndex = wdRed
.Text = ""
.Forward = True
.Wrap = wdFindStop
.MatchWildcards = False
End With
Do While .Find.Execute = True
i = i + 1
If .Information(wdWithInTable) = True Then
If .Rows(1).Range.Font.ColorIndex = wdRed Then .End = .Rows(1).Range.End
If .End = .Cells(1).Range.End - 1 Then .End = .Cells(1).Range.End
If .Information(wdAtEndOfRowMarker) = True Then .End = .End + 1
End If
.Editors.Add wdEditorEveryone
If .End = ActiveDocument.Range.End Then Exit Do
.Collapse wdCollapseEnd
If i Mod 100 = 0 Then DoEvents
Loop
End With
.Protect Password:="example123", NoReset:=False, Type:=wdAllowOnlyReading, UseIRM:=False, EnforceStyleLock:=False
End With
Application.ScreenUpdating = True
End Sub