none
Formating paragraphs based on the first characters RRS feed

  • Question

  • I have a word file (which I have created from Excel) that includes a code (2 letters and a space) at the start of each paragraph indicating the kind of style I want the paragraph to take on -- all this is successful.

    Now I am struggling to create a VBA Macro (for word) that goes through the word file paragraph by paragraph and changes the paragraph style based on the code (first two letters/first word) at the start of the paragraph.

    So my word file looks like:

    H1 jkhb  lkjn ljbn m ljn

    H2 lkj lknj l,nj ,lm jknljn lkn j;kl n;kn m

    BL lkjnn lknj l  lblopj I  ljkb l hbl j b

    etc.

    What I was hoping to create is a Macro that does something like (NOTE this is not my code -- it is my thinking):

    Sub format_para()

    For each paragraph in selection (note I would ideally like to do this to the text I select and not the whole file)

          If "the first two characters" = "H1" Then

                  change the style of the paragraph to "Heading 1"

           ElseIf "the first two characters" = "H2" Then

                  change the style of the paragraph to "Heading 2"

           ElseIf "the first two characters" = "BL" Then

                  change the style of the paragraph to "BL"

           End If

    Next paragraph

    Then I'd like to write another loop that replaces all the "H1 ", "H2 ", "BL " with nothing

    End Sub

    I have really and sincerely searched for clues, but am getting a little stuck -- if anybody can help me I would be so delighted.

    Thank you in anticipation

    Aarnout

    Sunday, November 9, 2014 5:10 PM

Answers

  • You could start with something like the following, which does the two things in one go:

    Sub ReStyle()
    Dim bRemoveParaMarker As Boolean
    Dim p As Word.Paragraph
    Dim rng As Word.Range
    For Each p In Selection.Paragraphs
      bRemoveParaMarker = True
      Select Case UCase(Left(p.Range.Text, 3))
        Case "H1 "
          p.Style = "Heading 1"
        Case "H2 "
          p.Style = "Heading 2"
        Case "BL "
          p.Style = "BL"
        Case Else
          ' do what you want, but...
    
          ' ...make sure we don't remove the marker
          bRemoveParaMarker = False 
      End Select
      If bRemoveParaMarker Then
       Set rng = p.Range
       rng.SetRange rng.Start, rng.Start + 3
       rng.Text = ""
       Set rng = Nothing
      End If
    Next


    End Sub

    Peter Jamieson

    • Marked as answer by Aarnout Sunday, November 9, 2014 8:25 PM
    Sunday, November 9, 2014 7:02 PM
  • The specific error you are getting is because you need to qualify the name of the "Selection" object with the object it belongs to, i.e. you need

    With appWd.Selection.Find

    (and that's everywhere that you use Selection.Find)

    This applies to everything that is a member of the Word Application object, so for example, you will need to qualify wdReplaceAll using, e.g.

    Word.wdReplaceAll

    or IMO the more complete

    Word.wdReplace.wdReplaceAll

    Otherwise you will get Excel's version of what "wdReplaceAll" means, and since in this case Excel does not define such a constant, you'll either get a compiler error or 0.

    Starting from your existing code, you could simplify the find/replace part by doing

    With appWd.Selection.Find
      .Text = "PI "
      .ReplacementText = ""
      .Forward = True
      .Execute Replace:=Word.wdReplace.wdReplaceAll
      .Text = "L1 "
      .ReplacementText = ""
      .Forward = True
      .Execute Replace:=Word.wdReplace.wdReplaceAll
    ' etc.
    End With

    However, because the text is probably going to be pasted with a tab rather than a space after each of your "style markers", you may need to modify both the style change code and the marker deletion code so that they look for

    "PI" & vbTab ' etc.

    rather than

    "PI "

    I think that will be enough for you to make progress. The only other thing to point out is that your code is probably currently searching the entire document (body) for those style change and find/replace operations. Perhaps the simplest choice :-)




    Peter Jamieson

    • Marked as answer by Aarnout Monday, November 10, 2014 4:04 PM
    Monday, November 10, 2014 9:36 AM

All replies

  • You could start with something like the following, which does the two things in one go:

    Sub ReStyle()
    Dim bRemoveParaMarker As Boolean
    Dim p As Word.Paragraph
    Dim rng As Word.Range
    For Each p In Selection.Paragraphs
      bRemoveParaMarker = True
      Select Case UCase(Left(p.Range.Text, 3))
        Case "H1 "
          p.Style = "Heading 1"
        Case "H2 "
          p.Style = "Heading 2"
        Case "BL "
          p.Style = "BL"
        Case Else
          ' do what you want, but...
    
          ' ...make sure we don't remove the marker
          bRemoveParaMarker = False 
      End Select
      If bRemoveParaMarker Then
       Set rng = p.Range
       rng.SetRange rng.Start, rng.Start + 3
       rng.Text = ""
       Set rng = Nothing
      End If
    Next


    End Sub

    Peter Jamieson

    • Marked as answer by Aarnout Sunday, November 9, 2014 8:25 PM
    Sunday, November 9, 2014 7:02 PM
  • Dear Peter,

    Many thanks -- really appreciated! Your solution pretty much did exactly what I wanted and more. Thank you!

    A follow up question if I may:

    Can I pretty much take this code and add it to the Excel Macro that pastes the text into the Word document? If yes maybe you can help we with one more step.  How can I get Word to select (or keep as selected) the text that has just been pasted in so that this code can work with that selection.

    Again, thank you for your kind help - very much appreciated.

    Best wishes

    Aarnout 

    Sunday, November 9, 2014 8:30 PM
  • You can start with something like the following - not tested much:

    Sub doRestyle()
    ' You will need to make your Excel selection here, then
    ' call ReStyle passing the Word Application object that
    ' you have got via CreateObject, GetObject, or whatever
    ' e.g. something like...
    
    Dim wrd as Word.Application
    '
    '
    '
    Set wrd = CreateObject("Word.Application")
    '
    '
    '
    Call ReStyle(wrd)
    '
    '
    '
    End Sub
    
    
    Sub ReStyle(wrd As Word.Application)
    Dim bRemoveParaMarker As Boolean
    Dim lng As Long
    Dim p As Word.Paragraph
    Dim rng As Word.Range
    Dim rs As Long
    Dim srng As Word.Range
    rs = wrd.Selection.Start
    wrd.Selection.Paste
    Set srng = Selection.Range
    srng.SetRange rs, srng.End
    For Each p In srng.Paragraphs
      bRemoveParaMarker = True
      Select Case UCase(Left(p.Range.Text, 3))
        Case "H1 "
          p.Style = "Heading 1"
        Case "H2 "
          p.Style = "Heading 2"
        Case "BL "
          p.Style = "BL"
        Case Else
          ' do what you want, but...
          ' ...make sure we don't remove the marker
          bRemoveParaMarker = False
      End Select
      If bRemoveParaMarker Then
       Set rng = p.Range.Duplicate
       rng.SetRange rng.Start, rng.Start + 3
       rng.Text = ""
       Set rng = Nothing
      End If
    Next
    End 



    Peter Jamieson

    Sunday, November 9, 2014 10:26 PM
  • Dear Peter,

    Many thanks for your kind efforts and patience.  I appreciate your support very much.

    I was unable to implement what you have suggested. I am going to try to paste my Excel Macro below with a comment of where it crashes.  Would you mind looking at it to see if you can help me?

    Many thanks

    Aarnout

    Sub Create_report()
    
    '   Copy and paste the Patient info'
    
    Sheets("Patient info").Select
       Range(Cells(2, 7), Cells(7, 8)).Select
       Selection.Copy
    
    Sheets("Report").Select
       Cells(1, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
    PasteRow = 7
    
    '   Copy and paste the Background info'
    
    For Rw = 3 To 60
    
        Sheets("Background").Select
        If Cells(Rw, 1).Value = "y" Then
            Cells(Rw, 14).Select
            Selection.Copy
    
            Sheets("Report").Select
            Cells(PasteRow, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
            PasteRow = PasteRow + 1
        
        Else
        End If
        
    Next Rw
    
    '   Copy and paste the Therapy Goals info'
    
    For Rw = 3 To 60
    
        Sheets("Therapy Goals").Select
        If Cells(Rw, 1).Value = "y" Then
            Cells(Rw, 14).Select
            Selection.Copy
    
            Sheets("Report").Select
            Cells(PasteRow, 1).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
            
            PasteRow = PasteRow + 1
        
        Else
        End If
        
    Next Rw
    
    '   Clear the data'
    
    Sheets("Patient info").Select
    Range(Cells(2, 3), Cells(10, 3)).Select
    Selection.ClearContents
    
    Sheets("Background").Select
    Range("A3:A100,e3:e100,g3:g100,i3:i100").Select
    Selection.ClearContents
    
    Sheets("Therapy Goals").Select
    Range("A3:A100").Select
    Selection.ClearContents
    
    '   Copy and Paste the report into Word report Master'
    
    Sheets("Report").Select
    Range(Cells(1, 1), Cells(PasteRow, 2)).Select
        Selection.Copy
    
    Dim appWd As Word.Application
    Set appWd = CreateObject("word.Application.15")
    appWd.Visible = True
        
    Set myDoc = appWd.Documents.Open("C:\Users\.'The correct path inserted here..\Speech therapy report Master.docx")
    
    myDoc.Paragraphs(10).Range.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
            wdInLine, DisplayAsIcon:=False
            
    '   Set the styles'
            
    Dim p As Word.Paragraph
    Dim rng As Word.Range
    
    For Each p In myDoc.Paragraphs
    
        Select Case UCase(Left(p.Range.Text, 3))
            Case "PI "
              p.Style = ActiveDocument.Styles("LR Pat. inf.")
            Case "L1 "
              p.Style = ActiveDocument.Styles("LR L1 Head.")
            Case "L2 "
              p.Style = ActiveDocument.Styles("LR L2 Head.")
            Case "BL "
              p.Style = ActiveDocument.Styles("LR Bullet")
        End Select
    
    Next p
    
    ' This is where things go wrong... If I have the code that follows in a Word Macro it all works well. However from the Excel Macro it crashes at this point => it does not seem to like the "With Selection.Find" Note I rewrote your code for this part as I was having little luck with your version.'
      
    myDoc.Range.Select
    
        With Selection.Find
            .Text = "PI "
            .Replacement.Text = ""
            .Forward = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "L1 "
            .Replacement.Text = ""
            .Forward = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "BL "
            .Replacement.Text = ""
            .Forward = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
        With Selection.Find
            .Text = "L2 "
            .Replacement.Text = ""
            .Forward = True
        End With
        Selection.Find.Execute Replace:=wdReplaceAll
    
    Sheets("Report").Select
        Cells.Select
        Selection.ClearContents
    
    End Sub
    

    Monday, November 10, 2014 5:50 AM
  • The specific error you are getting is because you need to qualify the name of the "Selection" object with the object it belongs to, i.e. you need

    With appWd.Selection.Find

    (and that's everywhere that you use Selection.Find)

    This applies to everything that is a member of the Word Application object, so for example, you will need to qualify wdReplaceAll using, e.g.

    Word.wdReplaceAll

    or IMO the more complete

    Word.wdReplace.wdReplaceAll

    Otherwise you will get Excel's version of what "wdReplaceAll" means, and since in this case Excel does not define such a constant, you'll either get a compiler error or 0.

    Starting from your existing code, you could simplify the find/replace part by doing

    With appWd.Selection.Find
      .Text = "PI "
      .ReplacementText = ""
      .Forward = True
      .Execute Replace:=Word.wdReplace.wdReplaceAll
      .Text = "L1 "
      .ReplacementText = ""
      .Forward = True
      .Execute Replace:=Word.wdReplace.wdReplaceAll
    ' etc.
    End With

    However, because the text is probably going to be pasted with a tab rather than a space after each of your "style markers", you may need to modify both the style change code and the marker deletion code so that they look for

    "PI" & vbTab ' etc.

    rather than

    "PI "

    I think that will be enough for you to make progress. The only other thing to point out is that your code is probably currently searching the entire document (body) for those style change and find/replace operations. Perhaps the simplest choice :-)




    Peter Jamieson

    • Marked as answer by Aarnout Monday, November 10, 2014 4:04 PM
    Monday, November 10, 2014 9:36 AM
  • Dear Peter,

    Many thanks! My job is done -- thanks to you for your care and patience.

    This was my first foray into managing a Word document from an Excel Macro -- a steep learning curve, but worth it.

    Thank you for your care and perseverance with this. Appreciated!

    Best wishes

    Aarnout

    PS in case somebody reads our conversation:

    The code:

    .ReplacementText = ""  etc.

    should be:

    .Replacement.Text = ""

    And, the code:

    p.Style = ActiveDocument.Styles("LR Pat. inf.") etc.

    should be:

    p.Style = appWd.ActiveDocument.Styles("LR Pat. inf.")

    Monday, November 10, 2014 4:03 PM
  • Aarnout,

    Well spotted on the other things that needed to be changed.

    FWIW when you get a reference such as myDoc when you create the document, it is good practice to use that reference rather than ActiveDocument (assuming that myDoc *is* the Activedocument!), so, e.g. it may be better to use

    p.Style = myDoc.Styles("LR Pat. inf.")

    Now you've been through that learning curve yourself, if you are going to be doing a lot of this, it will probably be worth looking around for other code samples that deal with pasting in Word and pasting from Excel, as you may find some "best practices" that deal with types of problem we haven't tried to deal with here. Just my 2c-worth - I don't have any specific suggestions.


    Peter Jamieson

    Monday, November 10, 2014 4:15 PM