Solved

Need Word Macro to Find and Change Entire Line to Style

Posted on 2016-07-21
6
40 Views
Last Modified: 2016-07-21
Need a macro that would find Sub in the below example, highlight the rest of line (it can include the word Sub) and then
change the style to Heading 2.  It need it to run until it reaches the end of the document.

Sub InsertPics()
 Dim fd As FileDialog
 Dim rng As Range
 Dim ilsh As InlineShape
0
Comment
Question by:Alex972
  • 4
6 Comments
 
LVL 31

Accepted Solution

by:
Helen_Feddema earned 500 total points
ID: 41723826
I have a Word macro that does this (and a lot more).  I use it to format code for readability.  I just copy a procedure, paste it into a document made from the template, and it applies formatting to the entire procedure.  Here is the code, which you could paste into a new template and modify as needed.

Sub Test()

   Debug.Print "Docs path: " & Options.DefaultFilePath(wdDocumentsPath)
   Debug.Print "Current path: " & Options.DefaultFilePath(wdCurrentFolderPath)
   Debug.Print "Template path: " & Options.DefaultFilePath(wdUserTemplatePath)
   

End Sub

Sub FormatCode()
'Created 03-26-1997 by Helen Feddema
'Last modified 11-10-2003

   Dim strTitle As String
   Dim strFindText As String
   Dim strReplaceText As String
   Dim rngSave As Range
   Dim strApostrophe As String
   Dim lngEnd As Long
   Dim rngEnd As Range
   Dim varPosition As Variant
   
   With Selection
      .WholeStory
      .Style = ActiveDocument.Styles("Code")
      .HomeKey Unit:=wdStory
      .Find.ClearFormatting
      .Find.Replacement.ClearFormatting
   End With
   
   'Insert page breaks between procedures
   strFindText = "^pSub"
   strReplaceText = "^p^mSub"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = strFindText
   strReplaceText = "^p^mPrivate Sub"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = "^pPrivate Sub"
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pFunction"
   strReplaceText = "^p^mFunction"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pProperty Get"
   strReplaceText = "^p^mProperty Get"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pProperty Let"
   strReplaceText = "^p^mProperty Let"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pProperty Set"
   strReplaceText = "^p^mProperty Set"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pPublic Function"
   strReplaceText = "^p^mPublic Function"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pPublic Sub"
   strReplaceText = "^p^mPublic Sub"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   strFindText = "^pPrivate Function"
   strReplaceText = "^p^mPrivate Function"
   
   Selection.Find.ClearFormatting
   Selection.Find.Replacement.ClearFormatting
   With Selection.Find
      .Text = strFindText
      .Replacement.Text = strReplaceText
      .Forward = True
      .Wrap = wdFindContinue
      .Format = False
   End With
   Selection.Find.Execute Replace:=wdReplaceAll
   
   'Format procedure headings with Heading 2 style
   Set rngSave = Selection.Range
   Selection.HomeKey Unit:=wdStory
   
   strFindText = "^p^mSub"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPrivate Sub"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mFunction"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mProperty"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPublic Function"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPublic Sub"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   strFindText = "^p^mPrivate Function"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Heading 2")
         Selection.MoveRight
         .Execute
      Wend
      rngSave.Select
   End With
   
   'Apply Label style to labels
   strFindText = ":^p"
   
   With Selection.Find
      .ClearFormatting
      .Execute findtext:=strFindText
      While .Found = True
         Selection.HomeKey Unit:=wdLine
         Selection.EndKey Unit:=wdLine, Extend:=wdExtend
         Selection.Style = ActiveDocument.Styles("Label")
         Selection.MoveRight Unit:=wdCharacter, Count:=1
         .Execute
      Wend
      rngSave.Select
   End With
   
   'Apply Comment style to comments
   strFindText = Chr$(39)
      With Selection.Find
         .ClearFormatting
         .Execute findtext:=strFindText
         While .Found = True
            'Test whether apostrophe is not at beginning of line
            varPosition = _
               Selection.Information(wdHorizontalPositionRelativeToTextBoundary)
            'Debug.Print "Position of apostrophe: " & varPosition
            If varPosition < 140 Then
               Selection.EndKey Unit:=wdLine, Extend:=wdExtend
               Selection.Style = ActiveDocument.Styles("Comment")
               Selection.MoveRight Unit:=wdCharacter, Count:=1
               .Execute
            Else
               Selection.MoveRight Unit:=wdCharacter, Count:=1
               .Execute
            End If
         Wend
         rngSave.Select
      End With
   
   'Format document heading with Heading 2 style
   Selection.EndKey Unit:=wdLine, Extend:=wdExtend
   Selection.Style = ActiveDocument.Styles("Heading 2")
   Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
   strTitle = Selection
   
   If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
      ActiveWindow.Panes(2).Close
   End If
   If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
      ActivePane.View.Type = wdOutlineView Or ActiveWindow.ActivePane.View.Type _
       = wdMasterView Then
      ActiveWindow.ActivePane.View.Type = wdPageView
   End If
   
   'Suggest document title, and save user's choice to Title field
   If ActiveDocument.BuiltInDocumentProperties("Title") = "None" Then
      If Left(strTitle, 23) <> "Option Compare Database" Then
         ActiveDocument.BuiltInDocumentProperties("Title") = strTitle
      Else
         strTitle = InputBox(prompt:="Please enter the document name", Title:="Document Name", Default:="___ Form Module")
         ActiveDocument.BuiltInDocumentProperties("Title") = strTitle
         Selection.HomeKey Unit:=wdLine
         Selection.MoveDown Unit:=wdLine, Count:=3, Extend:=wdExtend
         Selection.Delete Unit:=wdCharacter, Count:=1
         Selection.TypeText Text:=strTitle
         Selection.TypeParagraph
      End If
   End If
   
End Sub

Open in new window


I am also attaching the template, in case you want to try it.  To use it, first copy the code to the clipboard, then make a new document from template; it will ask if you want to import the code from the clipboard -- say Yes.  Then run the FormatCode macro to do the formatting.  (I put it on the Quick Access Toolbar.)
0
 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 41723828
The .dotm extension wasn't accepted; I tried using a zip file with it inside, but that was rejected too.  If you want the template emailed to you, send me a message with your email.
0
 
LVL 31

Expert Comment

by:Paul Sauvé
ID: 41723898
you can use ee-stuff.com to upload blocked files using your E-E creds to login: https://www.ee-stuff.com/

To upload:
select Experts Area ―> Upload a new file ―> Question or Article URL ―> upload file

To download:
select Experts Area ―> Find files for a question ―> Question URL ―> download file
0
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 41723915
I uploaded the template to ee-stuff.
0
 
LVL 31

Expert Comment

by:Helen_Feddema
ID: 41723930
Here is a screen shot of a page of formatted code:

Formatted code
0
 

Author Closing Comment

by:Alex972
ID: 41723940
Very good. Thanks
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

There is a feature provided by MS Word that lets you create an Table of Contents for your Word document automatically. To use this feature for other documents there are two steps involved,   1.  Prepare your document for a table of contents (he…
This is written from a 'VBA for MS Word' perspective, but I am sure it applies to most other MS Office components where VBA is used.  One thing that really bugs me is slow code, ESPECIALLY when it's mine!  In programming there are so many ways to…
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.

760 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

21 Experts available now in Live!

Get 1:1 Help Now