Помогите изменить макрос MS Word, чтобы использовать строку, а не заменять диалоговое окно

#vba #ms-word

#vba #ms-word

Вопрос:

Я нашел этот макрос для Word, который заменяет текст в любом месте (верхние, нижние колонтитулы, основную часть, текстовые поля), что мне и нужно, но единственная проблема в том, что он использует диалоговое окно замены. Что мне нужно, так это использовать строку в макросе для замены вместо этого. Но как бы я ни старался, я не могу заставить это работать.

Кто-нибудь захочет помочь? Вот исходный макрос (из MVP), который мне нужно изменить, чтобы использовать строку, а не диалоговое окно замены (поле ввода):

 Public Sub FindReplaceAnywhere()
  Dim rngStory As Word.Range
  Dim pFindTxt As String
  Dim pReplaceTxt As String
  Dim lngJunk As Long
  Dim oShp As Shape
  pFindTxt = InputBox("Enter the text that you want to find." _
    , "FIND" )
  If pFindTxt = "" Then
    MsgBox "Cancelled by User"
    Exit Sub
  End If
  TryAgain:
  pReplaceTxt = InputBox( "Enter the replacement." , "REPLACE" )
  If pReplaceTxt = "" Then
    If MsgBox( "Do you just want to delete the found text?", _
     vbYesNoCancel) = vbNo Then
      GoTo TryAgain
    ElseIf vbCancel Then
      MsgBox "Cancelled by User."
      Exit Sub
    End If
  End If
  'Fix the skipped blank Header/Footer problem
  lngJunk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType
  'Iterate through all story types in the current document
  For Each rngStory In ActiveDocument.StoryRanges
    'Iterate through all linked stories
    Do
      SearchAndReplaceInStory rngStory, pFindTxt, pReplaceTxt
      On Error Resume Next
      Select Case rngStory.StoryType
      Case 6 , 7 , 8 , 9 , 10 , 11
        If rngStory.ShapeRange.Count > 0 Then
          For Each oShp In rngStory.ShapeRange
            If oShp.TextFrame.HasText Then
              SearchAndReplaceInStory oShp.TextFrame.TextRange, _
                  pFindTxt, pReplaceTxt
            End If
          Next
        End If
      Case Else
        'Do Nothing
      End Select
      On Error GoTo 0
      'Get next linked story (if any)
      Set rngStory = rngStory.NextStoryRange
    Loop Until rngStory Is Nothing
  Next
End Sub
Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _
    ByVal strSearch As String , ByVal strReplace As String )
  With rngStory.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = strSearch
    .Replacement.Text = strReplace
    .Wrap = wdFindContinue
    .Execute Replace:=wdReplaceAll
  End With
End Sub
  

И вот пример того, что я имею в виду, используя строку для замены текста, а не диалогового окна (я хочу заменить несколько объектов одновременно — StrOld заменяется StrNew):

 Sub MultiReplaceAtCursor()
Dim StrOld As String, StrNew As String
Dim RngFind As Range, RngTxt As Range, i As Long
StrOld = "°|©|H"
StrNew = "¾|¶|e"
Set RngTxt = Selection.Range
For i = 0 To UBound(Split(StrOld, "|"))
  Set RngFind = RngTxt.Duplicate
  With RngFind.Find
    .ClearFormatting
    .Replacement.ClearFormatting
    .Text = Split(StrOld, "|")(i)
    .Replacement.Text = Split(StrNew, "|")(i)
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchKashida = False
        .MatchDiacritics = False
        .MatchAlefHamza = False
        .MatchControl = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    .Execute Replace:=wdReplaceAll
  End With
Next
End Sub
  

Спасибо за вашу помощь!
-Nathan

Ответ №1:

 Public Sub FindReplaceAnywhere()
Dim oldString, newString As String ' The two strings you want
Dim rngStory As Word.Range
Dim pFindTxt As String
Dim pReplaceTxt As String
Dim lngJunk As Long
Dim oShp As Shape
oldString = "Your string to find" ' Replace this value by the string to find
newString = "Your replacement" ' Replace this value string by the replacement you want
'Fix the skipped blank Header/Footer problem
lngJunk = ActiveDocument.Sections( 1 ).Headers( 1 ).Range.StoryType
'Iterate through all story types in the current document
For Each rngStory In ActiveDocument.StoryRanges
     'Iterate through all linked stories
     Do
       SearchAndReplaceInStory rngStory, oldString, newString
       On Error Resume Next
       Select Case rngStory.StoryType
       Case 6 , 7 , 8 , 9 , 10 , 11
           If rngStory.ShapeRange.Count > 0 Then
               For Each oShp In rngStory.ShapeRange
                   If oShp.TextFrame.HasText Then   
                       SearchAndReplaceInStory oShp.TextFrame.TextRange, _ oldString, newString
                   End If
               Next       
           End If       
       Case Else         'Do Nothing 
       End Select      
       On Error GoTo 0       'Get next linked story (if any)   
       Set rngStory = rngStory.NextStoryRange    
   Loop Until rngStory Is Nothing  
Next
End Sub

Public Sub SearchAndReplaceInStory(ByVal rngStory As Word.Range, _ ByVal strSearch As String , ByVal strReplace As String )  
With rngStory.Find
     .ClearFormatting
     .Replacement.ClearFormatting
     .Text = strSearch
     .Replacement.Text = strReplace
     .Wrap = wdFindContinue
     .Execute Replace:=wdReplaceAll
   End With
End Sub 
  

Ответ №2:

если я вас правильно понял, минимум, который вы можете сделать, это заменить

 pFindTxt = InputBox("Enter the text that you want to find.", "FIND" )
  

с помощью

 pFindTxt = "string to find"
  

и

 pReplaceTxt = InputBox( "Enter the replacement." , "REPLACE" )
  

с помощью

 pReplaceTxt = "replacement"
  

в вашем первом примере где "string to find" — это то, что вы заменяете, а "replacement" — текст, которым вы хотите его заменить. Это приведет к удалению диалоговых окон и явному указанию того, что вы хотите найти / заменить. Это так просто?