View Single Post
 
Old 02-20-2023, 06:29 PM
BrianHoard BrianHoard is offline Windows 10 Office 2019
Advanced Beginner
 
Join Date: Jul 2022
Location: Haymarket, VA USA
Posts: 85
BrianHoard is on a distinguished road
Default

Your script looks a whole lot like my first VBA script before I knew how to make a loop. One challenge I think you are going to face with trying to access the first line of a page, is that may not be a reliable thing to find as paragraphs move about and text flows from page to page.

But, here is a start which at least shows you how you can loop through the document and get close. Unless you have some more consistent/fixed way to find the first line of each page. In this script, I also made this text red to make it easy to see what it's doing. In my test, what was originally the first line of a page, was moved, so subsequent "first lines" were unpredictable.
Code:
Sub formatFirstLine()

    Dim rngPageStart As Range
    Dim rngFirstLine As Range
    Dim i As Integer
    Dim scriptName As String
    
    scriptName = "formatFirstLine"
        
    Application.ScreenUpdating = False
    
    ' Begin undo record
    Set bhhUndo = Application.UndoRecord
    bhhUndo.StartCustomRecord (scriptName)
    
    'Loop through all pages in the document
    For i = 1 To ActiveDocument.BuiltInDocumentProperties("Number of Pages")
    
        'Go to the top of each page
        Set rngPageStart = ActiveDocument.GoTo(wdGoToPage, wdGoToAbsolute, i)
        
        'Select the first paragraph of the page
        Set rngFirstLine = rngPageStart.Paragraphs(1).Range
   '     rngFirstLine.End = rngFirstLine.End + 1 'extend the range to the next line
        
        'Apply formatting
        With rngFirstLine.ParagraphFormat
            .Alignment = wdAlignParagraphCenter
            .SpaceBeforeAuto = False
            .SpaceBefore = 0
            .SpaceAfterAuto = False
            .SpaceAfter = 0
            .LineSpacingRule = wdLineSpaceSingle
        End With
        
        With rngFirstLine.Font
            .Bold = True
            .ColorIndex = wdRed
        End With
    Next i
    
    Application.ScreenUpdating = True
    Application.ScreenRefresh
    bhhUndo.EndCustomRecord ' End undo
    
End Sub
Reply With Quote