Automatic Footers by default for all files VBA

[Hattie]

Hello,

I would like all, existing and new excel files to print a footer by default.
I don't really want to edit every file I make to have the same footer every time.
Or re-edit all existing files...

So i thought VBA would be perfect for this job.

I have the following VBA code in the BeforePrint event in the "ThisWorkBook" object of an excel file [ VBAProject(Book1) ] and it works.

Option Explicit
Private Sub Workbook_BeforePrint(Cancel As Boolean)

ActiveSheet.PageSetup.LeftFooter = "&8&""Arial""" & ActiveWorkbook.Name & " (" & ActiveSheet.Name & ")" & " (" & ActiveSheet.Range("B1:B1") & ")"

'Print Footer on charts if they exist
If Not (ActiveChart Is Nothing) Then
'Chart does exist
ActiveChart.PageSetup.LeftFooter = "&8&""Arial""" & ActiveWorkbook.Name & " (" & ActiveSheet.Name & ")" & " (" & ActiveSheet.Range("B1:B1") & ")"
End If

End Sub


I thought if i put this code into the BeforePrint event in the "ThisWorkBook" object of my VBAProject (Personal.XLSB)
then i would never have to look at it again and all existing and new files would print a footer by default because this code is in my personal.xlsb object.


but No

have i misunderstood the purpose of the personal object?

or have i failed to do something obvious?

thanks for any clues

 

[rlv01]

Your code uses the ActiveSheet and Activechart objects, so when you move your Workbook_BeforePrint event procedure to Personal.XLSB it will no longer work on the workbook you are trying to print. The code you move to your personal macro workbook should look something like this.

'Locate this sub in PERSONAL.XLSB
Sub WorkbookPrintSetup()
    ActiveSheet.PageSetup.LeftFooter = "&8&""Arial""" & ActiveWorkbook.Name & " (" & ActiveSheet.Name & ")" & " (" & ActiveSheet.Range("B1:B1") & ")"

    'Print Footer on charts if they exist
    If Not (ActiveChart Is Nothing) Then
        'Chart does exist
        ActiveChart.PageSetup.LeftFooter = "&8&""Arial""" & ActiveWorkbook.Name & " (" & ActiveSheet.Name & ")" & " (" & ActiveSheet.Range("B1:B1") & ")"
    End If
End Sub

If you then paste Application.Run "'" & "PERSONAL.XLSB" & "'!WorkbookPrintSetup" into the "ThisWorkBook" code module of whatever workbook you want to set up the footer each time it is printed, it should work.

'Locate in whatever workbook you want to set up the footer each time it is printed.
Private Sub Workbook_BeforePrint(Cancel As Boolean)
    Application.Run "'" & "PERSONAL.XLSB" & "'!WorkbookPrintSetup"
End Sub

(Tip: when posting code, please try to use 'code tags' to format the code as I have done above

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

it makes the code easier to read.)

 

[Hattie]

Thank you for this.

I have just got back from my Easter break.

I will give this a try.

Thanks agian and for the formatting tips.