Adding page numbers with VBA

[bubba100]

I have the task of upgrading out programs from Word 2003 to 2007. In one of the programs we copy a pre-existing Word document, rename it open set the page numbers to X of Y using automation from Excel. We then further add to that document ranges from the Excel workbook.

With Word 07 it appears somethings need changing. I can add "of Y" but can't get the "X". The following works in Word. But I can't seem to get the syntax correct from Excel.

ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter
Selection.Range.InsertAlignmentTab Alignment:=1
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE \* ArabicDash ", PreserveFormatting:=True
ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument

The line I just can't reference corretly is:
Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE \* ArabicDash ", PreserveFormatting:=True

Thanks in advance!!!

 

[fumei]

But I can't seem to get the syntax correct from Excel."

If you are doing this from Excel, then you must fully qualify your code to use the instance of Word you are using. Something like:

Dim wrdApp As Word.Application

' Set your instance, and then

wrdApp.Selection etc.etc.

Gerry

 

[bubba100]

Fumei- Thanks this is what I have in Excel and I did "try" and fully quaify the statement. But I no luck.

I don't like opening the footer but at this point don't know of another way.


Dim StrName As String
Dim i As Integer
Dim StrAudYr As String
Dim CurrentPath As String
Dim strFile As String
Dim strDropFile As String
Dim WordObj As Object
Dim Worddoc As Object
Dim Cnter As Integer
Dim varShtNum As Integer
Dim RefNm
Dim PageNumbers, SendVar, SendVar2, TaxType
Dim PageType
Dim PauseTime, Start, Finish, TotalTime
Dim PicVar, Msg2
Dim ActDocmt As String
Dim f As Word.Range
Dim AudPgTotal As Integer
On Error Resume Next
SendVar = 2
SendVar2 = "A"
TaxType = "IRP"
'Application.ScreenUpdating = False
Set WordObj = GetObject(, "Word.Application")
If Err <> 0 Then
Set WordObj = CreateObject("Word.Application")
Err.Clear
End If
WordObj.ActiveDocument.PageSetup.TopMargin = InchesToPoints(0.8)
WordObj.ActiveDocument.PageSetup.BottomMargin = InchesToPoints(0.8)
WordObj.ActiveDocument.PageSetup.LeftMargin = InchesToPoints(0.8)
WordObj.ActiveDocument.PageSetup.RightMargin = InchesToPoints(0.8)
WordObj.ActiveDocument.PageSetup.Gutter = InchesToPoints(0)
WordObj.ActiveDocument.PageSetup.HeaderDistance = InchesToPoints(0)
WordObj.ActiveDocument.PageSetup.FooterDistance = InchesToPoints(0)
WordObj.ActiveDocument.PageSetup.PageWidth = InchesToPoints(8.5)
WordObj.ActiveDocument.PageSetup.PageHeight = InchesToPoints(11)
WordObj.ActiveDocument.ActiveWindow.View.DisplayPageBoundaries = True
WordObj.ActiveDocument.ActiveWindow.ActivePane.View.Zoom.Percentage = 100
CurrentPath = ActiveWorkbook.Path
For i = 1 To Application.Sheets.Count
StrName = Application.Sheets(i).Name
If Left(StrName, 3) = "IRP" Then
AudPgTotal = Sheets(StrName).Range("S16") + Sheets(StrName).Range("S17") _
+ Sheets(StrName).Range("S18") + Sheets(StrName).Range("S19")
StrAudYr = Mid(StrName, 9)
strFile = CurrentPath & "\" & "Records Evaluation IRP" & StrAudYr & ".doc"
strDropFile = CurrentPath & "\" & "PrintIRP" & StrAudYr & "\" _
& "IRP" & StrAudYr & "AuditFile.doc"
FileCopy strFile, strDropFile
Set Worddoc = WordObj.Documents.Open(strDropFile)
' WordObj.Visible = False
WordObj.Visible = True
WordObj.Selection.EndKey Unit:=wdStory 'move to end of document
WordObj.Selection.InsertBreak Type:=wdSectionBreakNextPage 'creates page break adds page with header
WordObj.Selection.EndKey Unit:=wdStory ' move to end of document
Set f = WordObj.ActiveDocument.Sections(1).Footers(1).Range 'Added BG
WordObj.ActiveDocument.Sections(2).Headers(wdHeaderFooterPrimary).LinkToPrevious = False 'break link to previous
WordObj.ActiveDocument.Sections(2).Footers(wdHeaderFooterPrimary).LinkToPrevious = False 'break link to previous
WordObj.ActiveDocument.Sections(2).Headers(wdHeaderFooterPrimary).Range.Delete 'Added by BG delete header contents without opening
WordObj.ActiveDocument.Sections(2).Footers(wdHeaderFooterPrimary).Range.Delete 'Added by BG delete footer contents without opening

WordObj.Selection.HomeKey Unit:=wdStory 'move to first page of document
DoEvents
' WordBasic.ViewFooterOnly
WordObj.ActiveWindow.ActivePane.View.SeekView = wdSeekCurrentPageFooter 'added BG 11/5/09
WordObj.Selection.Range.InsertAlignmentTab Alignment:=1 'added BG 11/5/09
WordObj.Selection.MoveRight Unit:=wdCharacter, Count:=1
WordObj.Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
"PAGE \* ArabicDash ", PreserveFormatting:=True
WordObj.ActiveWindow.ActivePane.View.SeekView = wdSeekMainDocument 'added BG 11/5/09

' PauseTimer 'changed BG 11/5/09
With f
' WordObj.ActiveDocument.AttachedTemplate. _
AutoTextEntries("- PAGE -").Insert _
where:=f 'commented out BG 11/5/09 no longer worked
.Collapse Direction:=wdCollapseEnd
.Text = " of "
.Collapse Direction:=wdCollapseEnd
.Text = " - " & AudPgTotal & " -"
End With