View Single Post
 
Old 06-08-2018, 07:06 PM
bobk544 bobk544 is offline Windows 7 32bit Office 2010 32bit
Novice
 
Join Date: Apr 2009
Posts: 10
bobk544 is on a distinguished road
Default Need to apply Heading1 to select rows

Hello, i need to apply the Heading1 style to every every row that has the text string of
"C:\_XREF_ALL\App.2018" and the result i'm hoping for is that i will be able to collapse and expand the rows under each Heading1. And basically, this document contains a lot of program code and the beginning of each program starts with the C drive directory reference ie C:\_XREF_ALL\App.2018\Program1 for example. So i'm hoping that when i apply the Heading1 to the full row, i will be able to expand and collapse each program section of code, thanks for any help on this!

Code:
Sub HeaderApply()
Application.ScreenUpdating = False
Dim StrFnd As String, StrSty As String, StrRep As String, i As Long
StrFnd = "C:\_XREF_ALL\App.2018"
StrSty = " Strong,Heading 1,Character Style 1,Italic,Character Style 2"
StrRep = "Placeholder1^& Placeholder2,^&,^&,Placeholder3^& Placeholder4,^&"
With ActiveDocument.Range.Find
  .ClearFormatting
  .Replacement.ClearFormatting
  .Forward = True
  .Format = True
  .Wrap = wdFindContinue
  .MatchWildcards = True
  .Text = ActiveDocument.Range  'trying to get the whole row text here
  .Replacement.Style = StrSty
  .Execute Replace:=wdReplaceAll
  'For i = 0 To UBound(Split(StrFnd, ","))
  '  .Text = "#" & Split(StrFnd, ",")(i) & "[A-Za-z]@>"
  '  .Replacement.Style = Split(StrSty, ",")(i)
  '  .Replacement.Text = Split(StrRep, ",")(i)
  '  .Execute Replace:=wdReplaceAll
  'Next
End With
Application.ScreenUpdating = True
End Sub

Last edited by macropod; 06-08-2018 at 07:28 PM. Reason: Added code tags
Reply With Quote