Word programming

[fiveworlds]

So I am not used to the language word macros are written in but I wanted to make a macro to set up the page in a particular way. Here is what I have so far. Which works fine at the moment probably not minimal code but I am not trying to learn the whole language today. What I wanted to do was to add a page number as well starting from zero at the selected pages. I did manage to figure out how to add a word number which applied to the whole document but not the selected section

Sub references()
'
' Macro3 Macro
'
'
   Selection.Sort ExcludeHeader:=False, FieldNumber:="Paragraphs", _
        SortFieldType:=wdSortFieldAlphanumeric, SortOrder:=wdSortOrderDescending, _
         FieldNumber2:="", SortFieldType2:=wdSortFieldAlphanumeric, SortOrder2:= _
        wdSortOrderAscending, FieldNumber3:="", SortFieldType3:= _
        wdSortFieldAlphanumeric, SortOrder3:=wdSortOrderAscending, Separator:= _
        wdSortSeparateByTabs, SortColumn:=False, CaseSensitive:=False, LanguageID _
        :=wdEnglishIreland, SubFieldNumber:="Paragraphs", SubFieldNumber2:= _
        "Paragraphs", SubFieldNumber3:="Paragraphs"
    Selection.Sort BidiSort:=False, IgnoreThe:=True, IgnoreKashida:=False, _
        IgnoreDiacritics:=False, IgnoreHe:=False
    With Selection.ParagraphFormat
        .LeftIndent = CentimetersToPoints(0)
        .RightIndent = CentimetersToPoints(0)
        .SpaceBefore = 0
        .SpaceBeforeAuto = False
        .SpaceAfter = 0
        .SpaceAfterAuto = False
        .LineSpacingRule = wdLineSpaceSingle
        .Alignment = wdAlignParagraphJustify
        .WidowControl = True
        .KeepWithNext = False
        .KeepTogether = False
        .PageBreakBefore = False
        .NoLineNumber = False
        .Hyphenation = True
        .FirstLineIndent = CentimetersToPoints(0)
        .OutlineLevel = wdOutlineLevelBodyText
        .CharacterUnitLeftIndent = 0
        .CharacterUnitRightIndent = 0
        .CharacterUnitFirstLineIndent = 0
        .LineUnitBefore = 0
        .LineUnitAfter = 0
        .MirrorIndents = False
        .TextboxTightWrap = wdTightNone
        .CollapsedByDefault = False
        .ReadingOrder = wdReadingOrderLtr
        .AutoAdjustRightIndent = True
        .DisableLineHeightGrid = False
        .FarEastLineBreakControl = True
        .WordWrap = True
        .HangingPunctuation = True
        .HalfWidthPunctuationOnTopOfLine = False
        .AddSpaceBetweenFarEastAndAlpha = True
        .AddSpaceBetweenFarEastAndDigit = True
        .BaseLineAlignment = wdBaselineAlignAuto
    End With
     Dim iCount As Integer
   Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With

Do While Selection.Find.Found = True And iCount < 1000
        iCount = iCount + 1

        'Jump back to the start of the document.  Since you remove the
        'footnote place holder this won't pick up old results


        Selection.Find.Execute

        'On the last loop you'll not find a result so check here
        If Selection.Find.Found Then

            ''==================================
            '' Do your footnote magic here
            ''==================================

            'Reset the find parameters
            With Selection.Find
            .Text = "^p^p"
            .Replacement.Text = "^p"
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchWildcards = False
            .MatchFuzzy = False
            End With

            Selection.Find.Execute Replace:=wdReplaceAll
            Selection.Find.ClearFormatting
            Selection.Find.Replacement.ClearFormatting
        End If
    Loop
   Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p"
.Replacement.Text = "^p^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = "^p^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
Selection.Find.Execute Replace:=wdReplaceAll
With Selection.Find
.Text = "^p^p^p"
.Replacement.Text = "^p"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchByte = False
.MatchAllWordForms = False
.MatchSoundsLike = False
.MatchWildcards = False
.MatchFuzzy = False
End With
Selection.Find.Execute Replace:=wdReplaceAll


End Sub

Edited March 10, 2015 by fiveworlds

[Strange]

Not a bad approach. In one job, I decided to do all formatting with VBA macros because the documents had to be imported from another system, and it is much easier to keep documents consistent this way (as Word makes a crap job of applying a template to existing documents). Here is the code snippet to set the page footer, including adding a copyright and page number:

        ' set footer for odd pages
        Set r = .Footers(wdHeaderFooterPrimary).Range
        ' delete anything already there so we start with a clean slate
        r.Delete
        ' Insert footer text
        r.InsertAfter (vbTab & vbTab & CopyrightNotice)
        ' Insert page number after first tab
        r.SetRange Start:=r.Start + 1, End:=r.Start + 1
        ActiveDocument.Fields.Add Range:=r, Type:=wdFieldPage

I think I found I had to add the copyright text and the tabs first in order for there to be a place to insert the page number field. (But it is more than 5 years ago, so I don't really remember.)

 

There is a center aligned and a right aligned tab setting. The code to format the page footer is:

' Set page footer format
Private Sub FormatFooter()
    Dim s As Style
    
    Set s = GetParaStyle("Footer")
    With s
        .BaseStyle = ActiveDocument.Styles("Normal")
        With .Font
            .Size = 8
            .name = StandardHeaderFontName
            .Color = RGB(77, 77, 77)
            .Bold = True
            .Italic = False
        End With
        With .ParagraphFormat
            .LeftIndent = 0
            .FirstLineIndent = 0
            .LineSpacingRule = wdLineSpaceSingle
            .SpaceBefore = 0
            .SpaceAfter = 0
            With .TabStops
                .ClearAll
                .Add Position:=MillimetersToPoints(82.5), Alignment:=wdAlignTabCenter
                .Add Position:=MillimetersToPoints(165), Alignment:=wdAlignTabRight
            End With
        End With
        .Borders.DistanceFromTop = 8
        With .Borders(wdBorderTop)
            .LineStyle = wdLineStyleSingle
            .Color = wdColorBlack
            .LineWidth = wdLineWidth050pt
        End With
    End With
End Sub

Hope that helps...

[fiveworlds]

Managed it

Sub Footer2()

ActiveDocument.Words(1).Select
With ActiveDocument.Sections(1)

    Set r = .Footers(wdHeaderFooterPrimary).Range
           r.Delete
        ' Insert footer text
        r.InsertAfter (vbTab & vbTab & CopyrightNotice)
        ' Insert page number after first tab
        r.SetRange Start:=r.Start + 1, End:=r.Start
        ActiveDocument.Fields.Add Range:=r, Type:=wdFieldPage
End With
    Selection.InsertBreak Type:=wdSectionBreakNextPage
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type = wdNormalView Or ActiveWindow. _
        ActivePane.View.Type = wdOutlineView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
    Selection.HeaderFooter.LinkToPrevious = Not Selection.HeaderFooter. _
        LinkToPrevious
    With Selection.HeaderFooter.PageNumbers
        .NumberStyle = wdPageNumberStyleArabic
        .HeadingLevelForChapter = 0
        .IncludeChapterNumber = False
        .ChapterPageSeparator = wdSeparatorHyphen
        .RestartNumberingAtSection = True
        .StartingNumber = 1
    End With
    ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument
End Sub