PDA

View Full Version : [SOLVED:] Page X of Y in Footer (Word 2013)



davis1118
11-15-2017, 01:06 PM
I had very good results with this forum a few days ago with saving a backup copy into a new folder (thanks to Gmayor's awesome code), so I thought I would ask post another question. This is an extension of that same project, and I am stuck again. I have a macro saving a backup copy of the master file into a new folder called "Archive" and then it also saves a PDF version of the master document in the same directory as the master. Both of these functions are working fine. But my goal is to keep the name of the master file the same while only changing the footer during a save. This way I can link to the document without getting a broken link each save.

I am currently trying to automatically insert the "file name_current date" in the left footer along with the "Page x of y" in the center footer. I cannot believe how stuck I am with such a simple thing as inserting the footer, but I cannot figure it out after many searches and trials. I have it working in Excel with very minimal code, but Word is a whole new monster to me.

I did manage to find a macro to insert the "Page x of y", but the problem is when it's ran multiple times like it would if saved multiple times, then it keeps adding a new "Page x of y" into the footer.

Here is the code I'm currently using.

Sub FileSave()
On Error Resume Next
ActiveDocument.Save
BackupDoc ActiveDocument
lbl_Exit:
Exit Sub
End Sub

Private Sub BackupDoc(ByVal oDoc As Document)

'CENTER FOOTER
Dim rng As Range
With ThisDocument.Sections(1)
With .Footers(wdHeaderFooterPrimary)
Set rng = .Range.Duplicate
rng.Collapse wdCollapseEnd
rng.InsertBefore vbTab & "Page of "
rng.Collapse wdCollapseStart
rng.Move wdCharacter, 6
rng.Font.Size = 8
ThisDocument.Fields.Add rng, wdFieldPage
Set rng = .Range.Duplicate
rng.Collapse wdCollapseEnd
ThisDocument.Fields.Add rng, wdFieldNumPages



Dim myName As String
Dim ext As String
Dim myPath As String
Dim T As String
Dim fso As Object
If oDoc.Path = "" Then GoTo lbl_Exit

myName = Left(oDoc.Name, (InStrRev(oDoc.Name, ".") - 1))
ext = Right(oDoc.Name, Len(oDoc.Name) - InStrRev(oDoc.Name, "."))
myPath = ActiveDocument.Path & "\"

'SAVE AS PDF
ActiveDocument.ExportAsFixedFormat _
OutputFileName:=myPath & myName & ".pdf", _
ExportFormat:=wdExportFormatPDF

'SAVE IN ARCHIVE FOLDER
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(oDoc.Path & "\Archive") Then
fso.CreateFolder (oDoc.Path & "\Archive")
End If

T = Format(Now, "ddMmmyy hh mm ss")

fso.CopyFile oDoc.FullName, oDoc.Path & "\Archive\" & myName & "_" & T & "." & ext
lbl_Exit:
Set fso = Nothing

End With
End With
Exit Sub
End Sub

Hopefully I was clear enough with my issue, but please let me know if you need any clarification.

Thank you for the help. - David

davis1118
11-15-2017, 02:10 PM
As a side note......I realize I can setup the footer exactly the way I want above using the built in Field commands in Word. The reason I am trying to set the footer automatically is because there will be multiple engineers controlling multiple sets of documents. To minimize mistakes and keep the format consistent for every document I would rather have the footer controlled by a macro.

macropod
11-15-2017, 05:17 PM
Try:

Dim i As Long, bAdd As Boolean: bAdd = True
With ActiveDocument.Sections.First.Headers(wdHeaderFooterPrimary).Range
For i = 1 To .Fields.Count
If .Fields(i).Type = wdFieldPage Then
bAdd = False: Exit For
End If
Next
If bAdd = True Then
.InsertAfter vbTab & "Page "
.Fields.Add .Characters.Last, wdFieldEmpty, "PAGE", False
.InsertAfter " of "
.Fields.Add .Characters.Last, wdFieldEmpty, "NUMPAGES", False
End If
End With

davis1118
11-16-2017, 09:49 AM
THank you macropod! That works great, and it's one of the cleanest ways that I have seen to do this! I added in the file name and date for the left footer, but now I'm not sure how to change the format of the date. By default it shows as dd/mm/yyy. I would like to show the date as ddMmmyy. How can this be done?

Dim i As Long, bAdd As Boolean: bAdd = True
With ActiveDocument.Sections.First.Footers(wdHeaderFooterPrimary).Range
For i = 1 To .Fields.Count
If .Fields(i).Type = wdFieldPage Then
bAdd = False: Exit For
End If
Next
If bAdd = True Then
.Fields.Add .Characters.Last, wdFieldEmpty, "FILENAME", False
.InsertAfter "_"
.Fields.Add .Characters.Last, wdFieldEmpty, "DATE", False
.Fields.Add .Characters.Last, wdFieldEmpty, "TIME", False
.InsertAfter vbTab
.Fields.Add .Characters.Last, wdFieldEmpty, "PAGE", False
.InsertAfter " of "
.Fields.Add .Characters.Last, wdFieldEmpty, "NUMPAGES", False

End If
End With
Dim oSection As Section
Dim oHF As HeaderFooter
For Each oSection In ActiveDocument.Sections
For Each oHF In oSection.Footers
oHF.Range.Font.Size = 8
Next
Next

Thanks again for the help. - David

macropod
11-16-2017, 12:54 PM
I added in the file name and date for the left footer, but now I'm not sure how to change the format of the date. By default it shows as dd/mm/yyy. I would like to show the date as ddMmmyy. How can this be done?
Try:

Dim i As Long, bAdd As Boolean: bAdd = True
With ActiveDocument.Sections.First.Headers(wdHeaderFooterPrimary).Range
For i = 1 To .Fields.Count
If .Fields(i).Type = wdFieldPage Then
bAdd = False: Exit For
End If
Next
If bAdd = True Then
.Fields.Add .Characters.Last, wdFieldEmpty, "FILENAME", False
.InsertAfter "_"
.Fields.Add .Characters.Last, wdFieldEmpty, "DATE \@ ""DDMMMYYYY'_'hh:mm""", False
.InsertAfter vbTab & "Page "
.Fields.Add .Characters.Last, wdFieldEmpty, "PAGE", False
.InsertAfter " of "
.Fields.Add .Characters.Last, wdFieldEmpty, "NUMPAGES", False
End If
End With
Note: Word has no 'left footer' object. Although with proper alignment you get have content appear on the left side of the footer, it's not a 'left footer' like Excel has.

PS: When posting code, please use the code tags, indicated by the # button on the posting menu. Without them, your code loses much of whatever structure it had.

davis1118
11-16-2017, 01:28 PM
Thanks Paul, this works great! I appreciate the help and quick reply's back. Sorry, I still think like I'm using Excel. Word just doesn't make as much sense to me yet. But I probably just need to use it more.

That's good to know about using the code tags, I will make sure to use them in the future.

Thanks again for the help.