Я создал макрос для проверки ошибок пунктуации (пробелы перед запятыми, знаки вопроса и т. Д.).Куда я положу свою петлю?

Question

Я пытаюсь определить, где разместить цикл для грамматических ошибок.

Так что этот макрос должен циклически проходить по документу, пока он больше не сможет найти больше запросов (так, например,, он может найти пробел перед запятой и удалить его, но что, если бы было 2 пробела? Он должен вернуться к началу после завершения первого поиска).

Таким образом, после завершения цикла он должен выглядеть следующим образом:
","
","

Когда я запускаю это, мне нужно заменить все находки.

Затем документ должен быть сохранен, его копия сделана и помещена в другой каталог (еще не с этим - но если кто-то также может помочь с этим, он упоминается как strEbookFileName выше) - так что яЯ знаю, что цикл должен заканчиваться ДО этого, но я не знаю, должен ли он идти внутрь функции или когда функция вызывается.

Любая помощь будет принята с благодарностью!

Private Function FindReplace(docFind As Document, strFind As String, strReplace As String)

With docFind.Range.Find

.ClearFormatting
.Replacement.ClearFormatting
.Text = strFind

' SO!!! Should my loop be going here?
.Replacement.Text = strReplace
.Execute Replace:=wdReplaceAll


' MatchWilcards breaks it - work out how it all works
'.MatchWildcards = True

End With

End Function

Sub CleanUpFilesInFolder()

' - - - 1 - - -
' Variables
' Defined for FindAndReplace
Dim docEach As Document
Dim strFolder As String
Dim strFileName As String
Const strFileSUBPATH As String = "\Checked\"

' Defined for Ebook output folder
Dim strEbookFileName As String
Dim strEbookFolder As String
Const strEbookSUBPATH As String = "\Ebook\"

' - - - 2 - - -
' Directory locations

' Specify folder location - this contains location of the macro
strFolder = ThisDocument.Path & strFileSUBPATH
strFileName = Dir(PathName:=strFolder)

' Specify folder location - this contains output dir for Ebook files
strEbookFolder = ThisDocument.Path & strEbookSUBPATH
strEbookFileName = Dir(PathName:=strEbookFolder)


' - - - 3 - - -
' - - - B E G I N  P R O C E S S  - - -

' - - - S T E P  O N E - - -
' Process files in the Checked folder
' While the number of files is NOT 0
While strFileName <> vbNullString

' Open each file
Set docEach = Documents.Open(strFolder & strFileName)

' - - - S T E P  T W O
' - - - - - - - - - - - - - - - - - - - - - - - - - - -
' Here you set exactly what you want to find and replace
' Enter what you're trying to FIND in between the FIRST two ""
' Enter what you're trying to REPLACE in between the SECOND two ""

'
'
'
' OR SHOULD I BE LOOPING EACH CALL OF FINDREPLACE?

     ' Remove blank line between paragraphs
     ' Call FindReplace(docEach, "^p^p", "^p")
     ' Call FindReplace(docEach, " ^p", "^p")

     ' Replace double spaces with a single space
     Call FindReplace(docEach, "  ", " ")

     ' space before , error
      Call FindReplace(docEach, " ,", ", ")

     ' space before . error
     Call FindReplace(docEach, " .", ". ")

     ' space before ? error
     Call FindReplace(docEach, " ?", "? ")

     ' space before ! error
     Call FindReplace(docEach, " !", "! ")


     ' space before ; error
     Call FindReplace(docEach, " ;", "; ")


     ' space before : error
     Call FindReplace(docEach, " :", ": ")

     ' space after ( error
     Call FindReplace(docEach, "( ", "(")

     ' space before ) error
     Call FindReplace(docEach, " )", ")")

     ' space after " error
     ' T O  D O - Fucks up when you enable WildCards
     ' Call FindReplace(docEach, """ "", """"")


     'Capital letter after .
     ' T O  D O
     'Call FindReplace(docEach, ". [a-z]", ". [A-Z]", Start:=0)

     ' Replace two hyphens with em dash
     Call FindReplace(docEach, "--", "-")



' Save a copy of the file and close the file
' and add ability to copy file to Ebook dir AFTER changes have been made
' Not right - ActiveDocument.SaveAs2 FileName:=(Ebook & strFileName)

docEach.Close SaveChanges:=True

' Once all finds have been replaced, save a copy of each doc
' in the Ebook directory and
' Move on to next file

strFileName = Dir

Wend


End Sub

Answer 1

Ты слишком усложняешь вещи, ИМХО. Попробуйте:

Sub Demo()
Application.ScreenUpdating = False
With ActiveDocument.Range
  With .Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Forward = True
    .Wrap = wdFindContinue
    .Format = False
    .MatchWildcards = True
    .Text = " ([.,:;\?\!\)\}\]])"
    .Replacement.Text = "\1 "
    .Execute Replace:=wdReplaceAll
    .Text = "([\(\{\[]) "
    .Execute Replace:=wdReplaceAll
    .Text = "--"
    .Replacement.Text = "^+"
    .Execute Replace:=wdReplaceAll
    .Text = "[ ]{2,}"
    .Replacement.Text = " "
    .Execute Replace:=wdReplaceAll
  End With
End With
Application.ScreenUpdating = True
End Sub

Никаких петель не требуется.

Answer 2

Я попробовал ваш код со следующей модификацией, и он выполняет то, что, насколько я понимаю, он должен делать.

Private Function FindReplace(docFind As Document, strFind As String, strReplace As String)
    Do                           ' loop added
    With docFind.Range.Find

    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = strFind

    ' SO!!! Should my loop be going here?
    .Replacement.Text = strReplace
    .Execute Replace:=wdReplaceAll


    ' MatchWilcards breaks it - work out how it all works
    '.MatchWildcards = True
    If .Found = False Then Exit Do   ' Line Added
    End With
    Loop
End Function

в Sub CleanUpFilesInFolder закомментировал строку, чтобы избежать Dir command

'strEbookFileName = Dir(PathName:=strEbookFolder)

и почти до конца Dir Loop

'docEach.Save              ' May save changes in original files according to your choice
Application.DisplayAlerts = wdAlertsNone
docEach.SaveAs strEbookFolder & strFileName
docEach.Close False
Application.DisplayAlerts = wdAlertsAll

strFileName = Dir
Wend