Consulting

Results 1 to 7 of 7

Thread: Excel exectuing Word VBA; Issue with Find & Replace

  1. #1
    VBAX Regular
    Joined
    Jan 2018
    Posts
    12
    Location

    Excel exectuing Word VBA; Issue with Find & Replace

    I am having an issue executing Find & Replace VBA code from MSExcel operating on instance of MSWord.



    The following code instances demonstrate the difference when identical VBA code is executing in MSExcel and the same code is executed in MSWord.



    In the code, 6 lines of "Normal" style Text are created. Three of the lines are marked with "!# ", to provide tags to convert to "List Paragraph" style.



    The following code is executed from MSWord and works correctly:





    
    
     Sub TestCodeOperatingInWord()
    
     Dim wdDoc As Object
    
    
    
     Application.ScreenUpdating = False
    
    
    
     Set wdApp = CreateObject("Word.Application")
    
     Set wdDoc = Documents.Add 'Open new Word document
    
    
     wdDoc.Activate
    
     Visible = True
    
     Dim rng As Object
    
     Set rng = Application.ActiveDocument.Range(Start:=0, End:=0)
    
     Selection.EndKey wdStory, wdMove
    
     Selection.TypeText Text:="New text Line 1"
    
     Selection.InsertParagraph
    
    Selection.EndKey wdStory, wdMove
    
     Selection.TypeText Text:="New text Line 2"
    
     Selection.InsertParagraph
    
     Selection.EndKey wdStory, wdMove
    
     Selection.TypeText Text:="New text Line 3"
    
     Selection.InsertParagraph
    
     Selection.EndKey wdStory, wdMove
    
     Selection.TypeText Text:="!# A. New Indented Text Line 1"
    
     Selection.InsertParagraph
    
     Selection.EndKey wdStory, wdMove
    
     Selection.TypeText Text:="!# B. New Indented Text Line 2"
    
     Selection.InsertParagraph
    
     Selection.EndKey wdStory, wdMove
    
     Selection.TypeText Text:="!# C. New Indented Text Line 3"
    
     Selection.InsertParagraph
    
     With ActiveDocument.Content.Find
    
     .ClearFormatting
    
     .Style = ActiveDocument.Styles("Normal")
    
     With .Replacement
    
     .ClearFormatting
    
     .Style = ActiveDocument.Styles("List Paragraph")
    
     End With
    
     .Execute FindText:="!# ", ReplaceWith:="", _
    
     Format:=True, Replace:=wdReplaceAll
    
     End With
    
    
    
     ActiveDocument.Range.Select
    
     With Selection.Find
    
     .Text = "!# "
    
     .Replacement.Text = ""
    
     .Forward = True
    
     .Wrap = wdFindContinue
    
     .Format = False
    
     .MatchCase = False
    
     .MatchWholeWord = False
    
     .MatchWildcards = False
    
     .MatchSoundsLike = False
    
     .MatchAllWordForms = False
    
     End With
    
     Selection.Find.Execute Replace:=wdReplaceAll
    
    
    
     End Sub


    The following code executed from MSExcel does not perform Find and Replace:



    
    
     Sub TestCodeOperatingOnWordInstanceInExcel()
    
     Dim wdDoc As Object
    
    
    
     Set wdApp = CreateObject("Word.Application")
    
     Set wdDoc = wdApp.Documents.Add 'Open new Word document
    
    
    
     wdDoc.Activate
    
     wdApp.Visible = True
    
     Dim rng As Object
    
     Set rng = wdApp.Application.ActiveDocument.Range(Start:=0, End:=0)
    
     wdApp.Selection.EndKey wdStory, wdMove
    
     wdApp.Selection.TypeText Text:="New text Line 1"
    
     wdApp.Selection.InsertParagraph
    
     wdApp.Selection.EndKey wdStory, wdMove
    
     wdApp.Selection.TypeText Text:="New text Line 2"
    
     wdApp.Selection.InsertParagraph
    
     wdApp.Selection.EndKey wdStory, wdMove
    
     wdApp.Selection.TypeText Text:="New text Line 3"
    
     wdApp.Selection.InsertParagraph
    
     wdApp.Selection.EndKey wdStory, wdMove
    
     wdApp.Selection.TypeText Text:="!# A. New Indented Text Line 1"
    
     wdApp.Selection.InsertParagraph
    
     wdApp.Selection.EndKey wdStory, wdMove
    
     wdApp.Selection.TypeText Text:="!# B. New Indented Text Line 2"
    
     wdApp.Selection.InsertParagraph
    
    wdApp.Selection.EndKey wdStory, wdMove
    
     wdApp.Selection.TypeText Text:="!# C. New Indented Text Line 3"
    
     wdApp.Selection.InsertParagraph
    
    
    
     wdApp.ActiveDocument.Range.Select
    
     With wdApp.ActiveDocument.Content.Find
    
     .ClearFormatting
    
     .Style = wdApp.ActiveDocument.styles("Normal")
    
     With .Replacement
    
     .ClearFormatting
    
     .Style = wdApp.ActiveDocument.styles("List Paragraph")
    
     End With
    
    .Execute FindText:="!# ", ReplaceWith:="", _
    
     Format:=True, Replace:=wdReplaceAll
    
     End With
    
    
    
     wdApp.ActiveDocument.Range.Select
    
     With wdApp.Selection.Find
    
     .Text = "!# "
    
     .Replacement.Text = ""
    
     .Forward = True
    
     .Wrap = wdFindContinue
    
     .Format = False
    
     .MatchCase = False
    
     .MatchWholeWord = False
    
     .MatchWildcards = False
    
     .MatchSoundsLike = False
    
     .MatchAllWordForms = False
    
     End With
    
     wdApp.Selection.Find.Execute Replace:=wdReplaceAll
    
     End Sub


    Please note that MSWord definitions, e.g. wdFindContinue, may need to be converted to their elaborations:



     Public Const wdFindContinue As Long = 1


    Help greatly appreciated; this one has me stumped.

  2. #2
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    Option Explicit
    
     
    Sub test()
      Dim wdApp As Object
      Dim wdDoc As Object
      Dim rng As Object
      Dim s As String
     
      Application.ScreenUpdating = False
         
      Set wdApp = CreateObject("Word.Application")
      Set wdDoc = wdApp.Documents.Add 'Open new Word document
      wdApp.Visible = True
       
    
       
      s = vbCr & "New text Line 1"
      s = s & vbCr & "New text Line 2"
      s = s & vbCr & "New text Line 3"
      s = s & vbCr & "!# A. New Indented Text Line 1"
      s = s & vbCr & "!# B. New Indented Text Line 2"
      s = s & vbCr & "!# C. New Indented Text Line 3"
       
      Set rng = wdDoc.Range
       
      rng.Text = s
    
      With rng.Find
        .ClearFormatting
        .Style = wdDoc.Styles("Normal")  
        .MatchWildcards = True
         
        With .Replacement
          .ClearFormatting
          .Style = wdDoc.Styles("List Paragraph") 
        End With
         
        .Execute FindText:="\!# (*)", ReplaceWith:="\1", _
                Format:=True, Replace:=2  'wdReplaceAll
       
      End With
       
    End Sub

  3. #3
    VBAX Master paulked's Avatar
    Joined
    Apr 2006
    Posts
    1,007
    Location
    It seemed to work for me. The document looked like this:

    New text Line 1
    New text Line 2
    New text Line 3
    ____A. New Indented Text Line 1
    ____B. New Indented Text Line 2
    ____C. New Indented Text Line 3

    (without the lines!)
    Last edited by paulked; 01-21-2018 at 10:47 PM. Reason: Formatting not working
    Semper in excretia sumus; solum profundum variat.

  4. #4
    VBAX Regular
    Joined
    Jan 2018
    Posts
    12
    Location
    Interesting, I'm not familiar with the FindText/ReplaceWith formats you used, but it works. Some additional work on my part to prevent subsequent uses from continuing previous lettering, and to set the outline level for subsequent indentures (A. B. C. 1. 2. D. ...).

    This one has had me stumped for a week, much indebted to you and the forum for quick reply.
    M

  5. #5
    VBAX Regular
    Joined
    Jan 2018
    Posts
    12
    Location
    Supposing that I prepended "!# " for OutlineLevel1 of the "List Paragraph" style that I create, and "!## " for OutlineLevel2 of the "List Paragraph" styles I create. Could OutlineLevel be added to the Find/Replace above?

    The example above defaults to OutlineLevel = 1

    Producing a listing like this:

    New Text Line 1
    New Text Line 2
    New Text Line 3
    A. New Indented Text Line 1
    B. New Indented Text Line 2
    1. New Indented Text Line 1 at OutlineLevel 2

  6. #6
    VBAX Expert
    Joined
    Sep 2016
    Posts
    788
    Location
    Option Explicit
     
    Sub test2()
        Dim wdApp As Object
        Dim wdDoc As Object
        Dim rng As Object
        Dim s As String
         
        Application.ScreenUpdating = False
         
        Set wdApp = CreateObject("Word.Application")
        Set wdDoc = wdApp.Documents.Add 'Open new Word document
        wdApp.Visible = True
         
        s = vbCr & "New text Line 1"
        s = s & vbCr & "New text Line 2"
        s = s & vbCr & "New text Line 3"
        s = s & vbCr & "!# A. New Indented Text Line 1"
        s = s & vbCr & "!## B. New Indented Text Line 2"
        s = s & vbCr & "!# C. New Indented Text Line 3"
         
        Set rng = wdDoc.Range
         
        rng.Text = s
         
        With rng.Find
            .MatchWildcards = True
            
            .Replacement.ParagraphFormat.IndentCharWidth 1
        
            .Execute FindText:="\!# (*)", ReplaceWith:="\1", _
                    Format:=True, Replace:=2 'wdReplaceAll
            
            .Replacement.ParagraphFormat.IndentCharWidth 2
            
            .Execute FindText:="\!## (*)", ReplaceWith:="\1", _
                    Format:=True, Replace:=2 'wdReplaceAll
             
        End With
         
    End Sub

  7. #7
    VBAX Regular
    Joined
    Jan 2018
    Posts
    12
    Location
    Once again, thanks!

    Simple and elegant.
    meh

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •