嗨,大家可以帮助我,因为它真的让我很难创造宏,所以PLZ帮助我尽可能简单:)
我已经创建了一个用于在两个不同文档中复制和粘贴特定文本的宏。我几乎完成了这件事。运行宏的过程工作正常,但问题是当我点击完成的消息时,我的ms字变得没有响应我真的不知道为什么但有时候它正在工作。
有人可以帮助我解决问题,或者有人可以重建我的代码以获得更好的输出,谢谢。
enter code here
Dim iCount As Long
iCount = 0
Dim MyAr() As String
Dim i As Integer
i = 0
Do
ContinueLoop:
iCount = iCount + 1
Selection.EndKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = "checksum*>"""
.Replacement.Text = ""
.Forward = False
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute = False Then
MSG = MsgBox("Done Checking")
Selection.Find.Text = ","
Selection.Find.Execute Replace:=wdReplaceAll
Exit Do
Else
End If
Selection.MoveRight unit:=wdCharacter, Count:=2
Selection.Find.ClearFormatting
With Selection.Find
.Text = "*?.pdf"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
Selection.Find.Execute
ReDim Preserve MyAr(i)
MyAr(i) = Selection
Windows(1).Activate
Selection.HomeKey unit:=wdStory
Selection.Find.ClearFormatting
With Selection.Find
.Text = MyAr(0)
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = True
End With
If Selection.Find.Execute = True Then
Selection.Find.ClearFormatting
With Selection.Find
.Text = "keying*>"""
.Replacement.Text = ""
.Wrap = wdFindContinue
.MatchWildcards = True
End With
Selection.Find.Execute
Selection.MoveRight unit:=wdCharacter, Count:=2
Windows(2).Activate
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.MoveDown unit:=wdLine, Count:=2, Extend:=wdExtend
Selection.Cut
Windows(1).Activate
Selection.TypeParagraph
Selection.PasteAndFormat (wdPasteDefault)
Windows(2).Activate
Else
Windows(2).Activate
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.MoveDown unit:=wdLine, Count:=1, Extend:=wdExtend
Selection.Cut
Selection.HomeKey unit:=wdStory
Selection.PasteAndFormat (wdPasteDefault)
Selection.MoveUp unit:=wdParagraph, Count:=1
Selection.Find.Text = "ck"
Selection.Find.Execute
Selection.MoveRight unit:=wdCharacter, Count:=1
Selection.TypeText Text:=","
GoTo ContinueLoop
End If
Loop While Selection.Find.Execute = False
答案 0 :(得分:0)
我认为你有一个无限循环 - 将最后一行改为"循环而select.find.execute = true"因此,一旦find = false,它将停止搜索。