Correcting Excel VBA Code to Insert Custom Headers & Footers
- or -
Post a project like this3152
$
- Posted:
- Proposals: 4
- Remote
- #871221
- PRE-FUNDED
- Awarded
Description
Experience Level: Entry
General information for the business: Water Efficiency Solutions Company
Kind of development: Customization of existing program
Num. of modules: 1
Description of requirements/functionality: Dear Excel VBA expert
WE need help to fix up the code below so that it inserts the files referred to and inserts fixed custom Header and Footer names for all Sheets in a Workbook, and ideally also all charts if printed as a chart alone.
Note: You can use any file path to test. We can edit for our file path later.
Existing code - not working - pls simplify where possible
Option Explicit
Dim UndoError As Boolean, HaltOperation As Boolean
Public strLeftHeader As String, strMainHeader As String, strSubHeader As String, strSubHeader2 As String
Public strRightHeader As String, strAuthorName As String, strCenterFooter As String
Public strFilePath As String, strLeftFooter As String, strRightFooter As String
Public oChOrSht As Object
Public strRightLogoPathName As String, strLeftLogoPathName As String, LeftLogo As String, RightLogo As String
Public lLong As Long, lLat As Long
Sub aaWG_HeaderFooter()
strLeftLogoPathName = "W:\10 Admin\ArtworkLogos\Logos\WGLogoXS100x80pix.png"
strRightLogoPathName = "W:\10 Admin\ArtworkLogos\Logos\wave2012smExcel.png"
strMainHeader = "WaterGroup Pty Ltd"
strSubHeader = "www.watergroup.com.au"
Call SynchHeaderFooter
End Sub
Sub SynchHeaderFooter()
' Application.ScreenUpdating = False
strLeftHeader = "W:\10 Admin\ArtworkLogos\Logos\WGLogoXS100x80pix.png"
strRightHeader = "W:\10 Admin\ArtworkLogos\Logos\WGwaveCrnt.png"
For Each oChOrSht In ActiveWorkbook.Worksheets
oChOrSht.PageSetup.LeftHeaderPicture.Filename = strLeftLogoPathName
oChOrSht.PageSetup.RightHeaderPicture.Filename = strRightLogoPathName
strRightHeader = "&G"
strFilePath = "&Z&F &A"
strLeftFooter = "&""Arial,Italic""&8File: " & strFilePath & Chr(10) & _
"Printed: &D &T" & " Author: GHD"
' strCenterFooter = "- CONFIDENTIAL -"
strRightFooter = "&9Page &P of &N"
'InsertHeaderFooterSubRout
'InsertHeaderFooter
Next oChOrSht
Application.ScreenUpdating = True
' Unload frmHeaderFooter
'If chkPrintPreview = True Then
' ActiveWindow.SelectedSheets.PrintPreview
'End If
End Sub
Sub InsertHeaderFooter()
If Not ActiveChart Is Nothing Then ' to catch chart object within a sheet
Set oChOrSht = ActiveChart
Else
Set oChOrSht = ActiveSheet ' so it can object can be Chart or Sheet
End If
' select logo for top right corner
On Error GoTo FileNotAvailable
oChOrSht.PageSetup.LeftHeaderPicture.Filename = strLeftLogoPathName
strLeftHeader = "&G"
oChOrSht.PageSetup.RightHeaderPicture.Filename = strRightLogoPathName
strRightHeader = "&G"
FileNotAvailable:
If Err.Number <> 0 Then
MsgBox ("Sorry, cannot insert logo. File moved/renamed? Will do all else though.")
End If
strFilePath = "&Z&F &A"
'strFilePath = Right(strFilePath, 150) ' force it to be < chars
strLeftFooter = "&""Arial,Italic""&8File: " & strFilePath & Chr(10) & _
"Printed: &D &T" & " Author: GHD"
'If chkConfid = True Then
' strCenterFooter = "- CONFIDENTIAL -"
'Else
' strCenterFooter = ""
'End If
strRightFooter = "&9Page &P of &N"
'Sub InsertHeaderFooterSubRout()
With oChOrSht.PageSetup
.LeftHeader = strLeftHeader
' If Not strSubHeader = "" Then
' strSubHeader2 = Chr(10) & "&9" & strSubHeader
' End If
strSubHeader2 = Chr(10) & "&9" & strSubHeader
.CenterHeader = "&""Tahoma""&11" & strMainHeader & strSubHeader2
.RightHeader = strRightHeader
.LeftFooter = strLeftFooter
.CenterFooter = strCenterFooter
.RightFooter = strRightFooter
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.85)
.BottomMargin = Application.InchesToPoints(0.65)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.4)
End With
' couple of extra bits if it's a charts
On Error Resume Next
With ActiveChart.PageSetup
.RightFooter = "" ' no page x of y pages on charts
.ChartSize = xlFullPage
.CenterHorizontally = True
.CenterVertically = True
End With
End Sub
OS requirements: Windows
Extra notes:
Kind of development: Customization of existing program
Num. of modules: 1
Description of requirements/functionality: Dear Excel VBA expert
WE need help to fix up the code below so that it inserts the files referred to and inserts fixed custom Header and Footer names for all Sheets in a Workbook, and ideally also all charts if printed as a chart alone.
Note: You can use any file path to test. We can edit for our file path later.
Existing code - not working - pls simplify where possible
Option Explicit
Dim UndoError As Boolean, HaltOperation As Boolean
Public strLeftHeader As String, strMainHeader As String, strSubHeader As String, strSubHeader2 As String
Public strRightHeader As String, strAuthorName As String, strCenterFooter As String
Public strFilePath As String, strLeftFooter As String, strRightFooter As String
Public oChOrSht As Object
Public strRightLogoPathName As String, strLeftLogoPathName As String, LeftLogo As String, RightLogo As String
Public lLong As Long, lLat As Long
Sub aaWG_HeaderFooter()
strLeftLogoPathName = "W:\10 Admin\ArtworkLogos\Logos\WGLogoXS100x80pix.png"
strRightLogoPathName = "W:\10 Admin\ArtworkLogos\Logos\wave2012smExcel.png"
strMainHeader = "WaterGroup Pty Ltd"
strSubHeader = "www.watergroup.com.au"
Call SynchHeaderFooter
End Sub
Sub SynchHeaderFooter()
' Application.ScreenUpdating = False
strLeftHeader = "W:\10 Admin\ArtworkLogos\Logos\WGLogoXS100x80pix.png"
strRightHeader = "W:\10 Admin\ArtworkLogos\Logos\WGwaveCrnt.png"
For Each oChOrSht In ActiveWorkbook.Worksheets
oChOrSht.PageSetup.LeftHeaderPicture.Filename = strLeftLogoPathName
oChOrSht.PageSetup.RightHeaderPicture.Filename = strRightLogoPathName
strRightHeader = "&G"
strFilePath = "&Z&F &A"
strLeftFooter = "&""Arial,Italic""&8File: " & strFilePath & Chr(10) & _
"Printed: &D &T" & " Author: GHD"
' strCenterFooter = "- CONFIDENTIAL -"
strRightFooter = "&9Page &P of &N"
'InsertHeaderFooterSubRout
'InsertHeaderFooter
Next oChOrSht
Application.ScreenUpdating = True
' Unload frmHeaderFooter
'If chkPrintPreview = True Then
' ActiveWindow.SelectedSheets.PrintPreview
'End If
End Sub
Sub InsertHeaderFooter()
If Not ActiveChart Is Nothing Then ' to catch chart object within a sheet
Set oChOrSht = ActiveChart
Else
Set oChOrSht = ActiveSheet ' so it can object can be Chart or Sheet
End If
' select logo for top right corner
On Error GoTo FileNotAvailable
oChOrSht.PageSetup.LeftHeaderPicture.Filename = strLeftLogoPathName
strLeftHeader = "&G"
oChOrSht.PageSetup.RightHeaderPicture.Filename = strRightLogoPathName
strRightHeader = "&G"
FileNotAvailable:
If Err.Number <> 0 Then
MsgBox ("Sorry, cannot insert logo. File moved/renamed? Will do all else though.")
End If
strFilePath = "&Z&F &A"
'strFilePath = Right(strFilePath, 150) ' force it to be < chars
strLeftFooter = "&""Arial,Italic""&8File: " & strFilePath & Chr(10) & _
"Printed: &D &T" & " Author: GHD"
'If chkConfid = True Then
' strCenterFooter = "- CONFIDENTIAL -"
'Else
' strCenterFooter = ""
'End If
strRightFooter = "&9Page &P of &N"
'Sub InsertHeaderFooterSubRout()
With oChOrSht.PageSetup
.LeftHeader = strLeftHeader
' If Not strSubHeader = "" Then
' strSubHeader2 = Chr(10) & "&9" & strSubHeader
' End If
strSubHeader2 = Chr(10) & "&9" & strSubHeader
.CenterHeader = "&""Tahoma""&11" & strMainHeader & strSubHeader2
.RightHeader = strRightHeader
.LeftFooter = strLeftFooter
.CenterFooter = strCenterFooter
.RightFooter = strRightFooter
.LeftMargin = Application.InchesToPoints(0.5)
.RightMargin = Application.InchesToPoints(0.5)
.TopMargin = Application.InchesToPoints(0.85)
.BottomMargin = Application.InchesToPoints(0.65)
.HeaderMargin = Application.InchesToPoints(0.2)
.FooterMargin = Application.InchesToPoints(0.4)
End With
' couple of extra bits if it's a charts
On Error Resume Next
With ActiveChart.PageSetup
.RightFooter = "" ' no page x of y pages on charts
.ChartSize = xlFullPage
.CenterHorizontally = True
.CenterVertically = True
End With
End Sub
OS requirements: Windows
Extra notes:
Guenter H.
100% (1)Projects Completed
5
Freelancers worked with
1
Projects awarded
67%
Last project
15 Dec 2016
Australia
New Proposal
Login to your account and send a proposal now to get this project.
Log inClarification Board Ask a Question
-
There are no clarification messages.
We collect cookies to enable the proper functioning and security of our website, and to enhance your experience. By clicking on 'Accept All Cookies', you consent to the use of these cookies. You can change your 'Cookies Settings' at any time. For more information, please read ourCookie Policy
Cookie Settings
Accept All Cookies