Автоматизация ms Word с помощью макросов

#vba

#vba

Вопрос:

Привет, ребята, кто-нибудь может мне помочь, потому что мне действительно трудно, я новичок в создании макросов, поэтому, пожалуйста, помогите мне как можно проще 🙂

Я создал макрос для копирования и вставки определенного текста в два разных документа. Я почти закончил с этим. Процесс во время выполнения макроса работает нормально, но проблема в том, что когда я нажимаю на сообщение готово, мое ms word перестает отвечать, я действительно не знаю, почему, но иногда это работает.

Может кто-нибудь помочь мне разобраться в проблеме или кто-нибудь может восстановить мои коды для лучшего вывода спасибо.

 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
 

Ответ №1:

Я думаю, что у вас бесконечный цикл — измените последнюю строку на «Цикл при выборе.find.execute = true», чтобы он прекратил поиск, как только find = false .