Solved

How do I add an option to insert page numbers in this Word 2003 Macro?

Posted on 2009-02-16
13
375 Views
Last Modified: 2012-06-21
Hello Experts,
We currently have a document management system implemented at my firm.  When saving documents from Word 2003 into the system there is a macro that auto executes and places a footer in the document which contains the document number.  This document number is only significant in the document management system.  The problem is that when the macro executes it places the document number in the footer of the document and replaces previously put in page numbers.  We know that when Word places page numbers in a document they can either go in as a footer or head, we need it to go in as a footer.  So when the macro runs it replaces the current footer with document number footer.  

So what I would like to do is instead of having Word place the page numbers of a document in the footer, I would like the macro that auto executes to place page numbers into the document in addition to the document number itself.  The reason I would like it to prompt the user and not just insert page numbers is because some of our documents dont need page numbers.  

I dont have much experience in Word 2003 VBA, so I am not sure where in the macro code provided below I need to insert code for the page numbers.  I am also not sure how to place page numbers in the document via VBA.  

So again I would like this macro to be able to prompt the user for page numbers.  If the user hits YES, then page numbers get inserted into the document, either wise no page numbers need to be inserted.  Also I need to have page numbers on the bottom right footer of the document and have the standard document number in the document management system on the bottom left of the footer.  I think there is a way to do this by setting up columns in the footer, but I am not sure how.

As a work around the page numbers can be inserted after the document is saved in the document management system.  So page numbers do get inserted after the document is saved in the document management system, but we need the macro to keep from overriding page numbers when its run.  So that is why I want to pursue this solution of havin the macro insert page numbers not Word.  

Please let me know if you have any questions and I will answer them asap, cause i know this questions may be a little confusing.

FYI- The code I provided below is not the whole code for the macro.  I can provide more code, meaning the CLASS MODULE code for this module.  Also I have provided a picture of the way I would like the footer to look like after the macro is run.  I have already customized the macro in the code below with what I would like to show up in the footer when its being saved.  

Thanks!
' CUSTFT80E - WORKSITE VERSION 8.0

' ModFootDocument
 

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' This Module is designed for you to customize the footer of the active         '

' WorkSite document.  It allows you to:                                       '

'   (1) Select and order profile field information in AddFooterProfileInfo()    '

'   (2) Add any characters to separate the profile fields in AddFieldDividers() '

'   (3) Personalize the font style of the footer text in SetFooter()            '

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 

Option Explicit
 

'   Below is the function where you can select profile field info

'   to include in the footer of the active document.

'   If none chosen, the default profile info will be selected: "description:docnum_version"

'

Public Sub AddFooterProfileInfo(objFooter As FooterObject)

    On Error Resume Next

    

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

    ' TODO:                                                             '

    '   Assign a priority number, between 1 and 78,                     '

    '   to select the field and determine its priority to include       '

    '   in the footer; zero ("0") indicates the field is unselected.    '

    '                                                                   '

    ' EXAMPLE:                                                          '

    '   Selected fields:                                                '

    '       objFooter.AddThisProfileField Author, 2                     '

    '       objFooter.AddThisProfileField Database, 1                   '

    '       objFooter.AddThisProfileField DocNum, 3                     '

    '       objFooter.AddThisProfileField Version, 4                    '

    '   Footer is displayed in this order:                              '

    '       "DATABASEXXX/UserXXX/1111_1"                                '

    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
 

    ' If the value of each field is returned successfully, it will read:

        

    objFooter.AddThisProfileField Author, 0

        ' e.g., "JDoe"

    

    objFooter.AddThisProfileField AuthorDescription, 0

        ' e.g., "John Doe"

    

    objFooter.AddThisProfileField Class, 0

        ' e.g., "DOC"

        

    objFooter.AddThisProfileField ClassDescription, 0

        ' e.g., "Document"

        

    objFooter.AddThisProfileField Comment, 0

        ' e.g., "This is my comment..."

    

    objFooter.AddThisProfileField CreateDate, 0

        ' e.g., "4/5/2004 3:55:49 PM"

    

    objFooter.AddThisProfileField Custom1, 0

        ' e.g., "PARENT"

    

    objFooter.AddThisProfileField Custom1Description, 0

        ' e.g., "Parent description"

        

    objFooter.AddThisProfileField Custom2, 0

        ' e.g., "CHILD"

        

    objFooter.AddThisProfileField Custom2Description, 0

        ' e.g., "Child description"

        

    objFooter.AddThisProfileField Custom3, 0

        ' e.g., "CLIENT"

        

    objFooter.AddThisProfileField Custom3Description, 0

        ' e.g., "Client description"

        

    objFooter.AddThisProfileField Custom4, 0

        ' e.g., "CLIENT"

        

    objFooter.AddThisProfileField Custom4Description, 0

        ' e.g., "Client description"

        

    objFooter.AddThisProfileField Custom5, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom5Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom6, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom6Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom7, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom7Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom8, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom8Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom9, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom9Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom10, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom10Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom11, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom11Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom12, 0

        ' e.g., "CLIENT"

    

    objFooter.AddThisProfileField Custom12Description, 0

        ' e.g., "Client description"

    

    objFooter.AddThisProfileField Custom13, 0

        ' e.g., "I'm just a string of text!"

        

    objFooter.AddThisProfileField Custom14, 0

        ' e.g., "I'm just a string of text!"

    

    objFooter.AddThisProfileField Custom15, 0

        ' e.g., "I'm just a string of text!"

    

    objFooter.AddThisProfileField Custom16, 0

        ' e.g., "I'm just a string of text!"

    

    objFooter.AddThisProfileField Custom17, 0

        ' e.g., "1234567"

    

    objFooter.AddThisProfileField Custom18, 0

        ' e.g., "1234567"

    

    objFooter.AddThisProfileField Custom19, 0

        ' e.g., "1234567"

    

    objFooter.AddThisProfileField Custom20, 0

        ' e.g., "1234567"

    

    objFooter.AddThisProfileField Custom21, 0

        ' e.g., "1/9/2002 3:55:49 PM"

    

    objFooter.AddThisProfileField Custom22, 0

        ' e.g., "1/9/2002 3:55:49 PM"

    

    objFooter.AddThisProfileField Custom23, 0

        ' e.g., "1/9/2002 3:55:49 PM"

    

    objFooter.AddThisProfileField Custom24, 0

        ' e.g., "1/9/2002 3:55:49 PM"

    

    objFooter.AddThisProfileField Custom25, 0

        ' e.g., "CheckMe checked" if True; "CheckMe unchecked" if False.
 

    objFooter.AddThisProfileField Custom26, 0

        ' e.g., "CheckMe checked" if True; "CheckMe unchecked" if False.

    

    objFooter.AddThisProfileField Custom27, 0

        ' e.g., "CheckMe checked" if True; "CheckMe unchecked" if False.

    

    objFooter.AddThisProfileField Custom28, 0

        ' e.g., "CheckMe checked" if True; "CheckMe unchecked" if False.

    

    objFooter.AddThisProfileField Custom29, 0

        ' e.g., "PARENT"

                

    objFooter.AddThisProfileField Custom29Description, 0

        ' e.g., "Parent description"

    

    objFooter.AddThisProfileField Custom30, 0

        ' e.g., "CHILD"

    

    objFooter.AddThisProfileField Custom30Description, 0

        ' e.g., "Child description"

    

    objFooter.AddThisProfileField DatabaseName, 1

        ' e.g., "DATABASEXXX"

        

    objFooter.AddThisProfileField DefaultSecurity, 0

        ' e.g., "PRIVATE", "PUBLIC", or "VIEW"

        

    objFooter.AddThisProfileField Description, 0

        ' e.g., "This is my document description."

        

    objFooter.AddThisProfileField DocNum, 2

        ' e.g., "1111"

        

    objFooter.AddThisProfileField DocType, 0

        ' e.g., "WORD97"

        

    objFooter.AddThisProfileField DocTypeDescription, 0

        ' e.g., "MS Word 97"
 

    objFooter.AddThisProfileField EchoEnabled, 0

        ' e.g., "Echo enabled" if True; "Not echo enabled" if False.

        

    objFooter.AddThisProfileField EditDate, 0

        ' e.g., "4/5/2004 3:55:49 PM"
 

    objFooter.AddThisProfileField EditProfileTime, 0

        ' e.g., "4/5/2004"

    

    objFooter.AddThisProfileField EditTime, 0

        ' e.g., "12:52:05 PM"

        

    objFooter.AddThisProfileField Extension, 0

        ' e.g., ".doc"

        

    objFooter.AddThisProfileField Indexalbe, 0

        ' e.g., "Indexable" if True; "Not indexable" if False.
 

    objFooter.AddThisProfileField InUse, 0

        ' e.g., "In use" if True; "Not in use" if False.

        

    objFooter.AddThisProfileField InUseBy, 0

        ' e.g., "JDOE"

        

    objFooter.AddThisProfileField InUseByDescription, 0

        ' e.g., "John Doe"
 

    objFooter.AddThisProfileField IsRelated, 0

        ' e.g., "Related" if True, else "Unrelated".
 

    objFooter.AddThisProfileField LastUser, 0

        ' e.g., "ADMIN"
 

    objFooter.AddThisProfileField LastUserDescription, 0

        ' e.g., "Administrator"
 

    objFooter.AddThisProfileField Location, 0

        ' e.g., "MYSERVER:\MYMACHINE_4022DBXXX\DBXXX\ADMIN\0\1\1111.1"

        

    objFooter.AddThisProfileField MarkedForArchive, 0

        ' e.g., "Marked for archive" if -1; "Not marked for archive" if 0.
 

    objFooter.AddThisProfileField Name, 0

        ' e.g., "My Doc Name"

        

    objFooter.AddThisProfileField Operator, 0

        ' e.g., "JDOE"
 

    objFooter.AddThisProfileField OperatorDescription, 0

        ' e.g., "John Doe"
 

    objFooter.AddThisProfileField RetainDays, 0

        ' e.g., "365"
 

    objFooter.AddThisProfileField Size, 0

        ' e.g., "13846 bytes"
 

    objFooter.AddThisProfileField SubClass, 0

        ' e.g., "SUBDOC"

        

    objFooter.AddThisProfileField SubClassDescription, 0

        ' e.g., "Subdocument"
 

    objFooter.AddThisProfileField Version, 3

        ' e.g., "1"
 

End Sub
 

'   Below is the function where you can add profile field separators.

'   If ignored, the default separator will be ":" (e.g., MYDB:JSMITH:MyDescription),

'   and the character to separate Document and version number will be "_" (e.g., 1111_1).

'

Public Sub AddFieldDividers(strFieldDivider As String, strDocVerDivider As String)

    ' Assign a character as the field separator (i.e., "/", "\", etc.)

    '   or leave it empty to use the default separator, ":".

    strFieldDivider = ""

    

    ' Assign a character as the document and version number separator, (e.g., ".")

    '   or leave it empty to use the default separator, "_".

    strDocVerDivider = ""

End Sub
 

'   WORD IMPLEMENTATION: Insert the footer to the active document.

'   This is the function where you can personalize the footer text,

'   such as changing the font size, font name, etc.  Uncomment the lines

'   between SET FONT SPECIFICATION and ENDS SET FONT SPECIFICATION

'   to set values to font properties.

'

Public Sub SetFooter(ByVal strTextString As String)

    Dim objRange As Word.Range

    Dim objFont As Word.Font

    

    Set objRange = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range

    Set objFont = objRange.Font

    

    objRange.Style = wdStyleFooter

    objRange.Text = strTextString

    

    ' SET FONT SPECIFICATION

    

'    With objFont

'        .Name = "Arial"

'        .Size = 8

'        .Bold = False

'        .Italic = False

'        .Underline = wdUnderlineNone

'        .UnderlineColor = wdColorAutomatic

'        .StrikeThrough = False

'        .DoubleStrikeThrough = False

'        .Outline = False

'        .Emboss = False

'        .Shadow = False

'        .Hidden = False

'        .SmallCaps = False

'        .AllCaps = False

'        .Color = wdColorAutomatic

'        .Engrave = False

'        .Superscript = False

'        .Subscript = False

'        .Spacing = 0

'        .Scaling = 100

'        .Position = 0

'        .Kerning = 0

'        .Animation = wdAnimationNone

'    End With

    

    ' ENDS FONT SPECIFICATION
 

    If ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Exists = True Then

        ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text _

                = strTextString

    End If

    

    Set objRange = Nothing

    Set objFont = Nothing

End Sub

Open in new window

What-I-would-like-it-to-look-lik.JPG
0
Comment
Question by:navid86
13 Comments
 
LVL 37

Expert Comment

by:Joanne M. Orzech
Comment Utility
I may be able to help you ... but I won't be able to until Monday.

Joanne Orzech
Word MVP
0
 
LVL 2

Author Comment

by:navid86
Comment Utility
Okay, yeah if you could help that would be awesome.  I am hoping the solution won't be too complicated.  Please let me know if you need any further information to come to a solution and I will provide it to you ASAP.

Thanks for your help and response.
0
 
LVL 74

Expert Comment

by:Jeffrey Coachman
Comment Utility
Tickler for JOrzech
0
 
LVL 13

Expert Comment

by:John Mc Hale
Comment Utility
navid86

Don't know if this is what you're looking for, but if you modify your macro code for the Sub SetFooter() to something like this, which will insert page numbers with right alignment
'   WORD IMPLEMENTATION: Insert the footer to the active document.

'   This is the function where you can personalize the footer text,

'   such as changing the font size, font name, etc.  Uncomment the lines

'   between SET FONT SPECIFICATION and ENDS SET FONT SPECIFICATION

'   to set values to font properties.

'

Sub SetFooter(ByVal strTextString As String)

    Dim objRange As Word.Range

    Dim objFont As Word.Font

    

    Set objRange = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range

    Set objFont = objRange.Font

    

    objRange.Style = wdStyleFooter

    objRange.Text = strTextString

    

    ' SET FONT SPECIFICATION

    

'    With objFont

'        .Name = "Arial"

'        .Size = 8

'        .Bold = False

'        .Italic = False

'        .Underline = wdUnderlineNone

'        .UnderlineColor = wdColorAutomatic

'        .StrikeThrough = False

'        .DoubleStrikeThrough = False

'        .Outline = False

'        .Emboss = False

'        .Shadow = False

'        .Hidden = False

'        .SmallCaps = False

'        .AllCaps = False

'        .Color = wdColorAutomatic

'        .Engrave = False

'        .Superscript = False

'        .Subscript = False

'        .Spacing = 0

'        .Scaling = 100

'        .Position = 0

'        .Kerning = 0

'        .Animation = wdAnimationNone

'    End With

    

    ' ENDS FONT SPECIFICATION

 

    If ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Exists = True Then

        ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text _

                = strTextString

        If (MsgBox("Do you want page numbers in your document?", vbYesNo + vbQuestion, "Insert Page Numbers") = vbYes) Then

            ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:= _

            wdAlignPageNumberRight, FirstPage:=True

        End If

    End If

    

    Set objRange = Nothing

    Set objFont = Nothing

End Sub

Open in new window

0
 
LVL 2

Author Comment

by:navid86
Comment Utility
Works Great!  Except when I change the command on line 52 in the code you have provided directly above to FALSE, the fonts and settings specified in lines 20-42 do not take affect on the first page, the font does take effect after the first page.

But when I keep the command on line 52 equal to TRUE the font does get applied to all footers on all pages.  I would just like to have NO page numbers on the first page that is why I have changed the commande to FALSE.

So is there anyway to get it so the font and other settings of the footer remain the same for all pages with no page number on page 1?
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 13

Accepted Solution

by:
John Mc Hale earned 500 total points
Comment Utility
Adding page numbers to a footer, but not displaying them on the first page in effect creates a second (alternate) footer. Therefore, to maintain formatting, you must set the font of the 2nd footer to whatever the font for the first footer is.
'   WORD IMPLEMENTATION: Insert the footer to the active document.

'   This is the function where you can personalize the footer text,

'   such as changing the font size, font name, etc.  Uncomment the lines

'   between SET FONT SPECIFICATION and ENDS SET FONT SPECIFICATION

'   to set values to font properties.

'

Sub SetFooter(ByVal strTextString As String)

    Dim objRange As Word.Range

    Dim objFont As Word.Font

    

    Set objRange = ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Range

    Set objFont = objRange.Font

    

    objRange.Style = wdStyleFooter

    objRange.Text = strTextString

    

    ' SET FONT SPECIFICATION

    

    With objFont

        .Name = "Arial"

        .Size = 8

        .Bold = False

        .Italic = False

        .Underline = wdUnderlineNone

        .UnderlineColor = wdColorAutomatic

        .StrikeThrough = False

        .DoubleStrikeThrough = False

        .Outline = False

        .Emboss = False

        .Shadow = False

        .Hidden = False

        .SmallCaps = False

        .AllCaps = False

        .Color = wdColorAutomatic

        .Engrave = False

        .Superscript = False

        .Subscript = False

        .Spacing = 0

        .Scaling = 100

        .Position = 0

        .Kerning = 0

        .Animation = wdAnimationNone

    End With

    

    ' ENDS FONT SPECIFICATION

 

    If ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).Exists = True Then

        ActiveDocument.Sections(1).Footers(wdHeaderFooterFirstPage).Range.Text _

                = strTextString

        If (MsgBox("Do you want page numbers in your document?", vbYesNo + vbQuestion, "Insert Page Numbers") = vbYes) Then

            ActiveDocument.Sections(1).Footers(2).Range.Font = objFont

            ActiveDocument.Sections(1).Footers(wdHeaderFooterPrimary).PageNumbers.Add PageNumberAlignment:= _

            wdAlignPageNumberRight, FirstPage:=False

        End If

    End If

    

    Set objRange = Nothing

    Set objFont = Nothing

End Sub

Open in new window

0
 
LVL 13

Expert Comment

by:John Mc Hale
Comment Utility
Note line 51 in the code, sets the font of the 2nd page footer, you can then use False in the statement at line 53 to prevent page numbers from appearing on the first page
0
 
LVL 2

Author Comment

by:navid86
Comment Utility
Okay, cool!  One last question.  How can I set the font of the footer on the first page, since I can set it on the second page and so on?
0
 
LVL 2

Author Comment

by:navid86
Comment Utility
nvmd, answered my own question.
0
 
LVL 13

Expert Comment

by:John Mc Hale
Comment Utility
Clear?
0

Featured Post

Highfive Gives IT Their Time Back

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Office 365 is currently available in five editions. Three of them are for business use: Office 365 Business Essentials, Office 365 Business, and Office 365 Business Premium. Two of them are for home/personal use: Office 365 Home and Office 365 Perso…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

771 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

12 Experts available now in Live!

Get 1:1 Help Now