Mr_Mod
04-29-2018, 05:30 AM
I have the below code that i have set up to create a header, footer and manipulate some other bits on a page, this works all fine and i have this "Addfooter" code placed in the "Thisworkbook" area. But what I now want to do is apply this to all the sheets in the workbook at the press of a single button.
I have a separate module that with a button placed on what i call the cover page which allows me to print all active pages, so i would like to use this button to apply the headers/footers etc to all of the sheets in the workbook prior to print preview.
I cant figure out how to do this, any ideas?
Sub AddFooter()
'
' Adds Filename, Worksheet Name and Date (static or updated type) as Footer
'
Dim Response As Integer
Dim lenheader As String
Dim lenfooter As String
Dim wsSheet As Worksheet
Application.ScreenUpdating = False
' get workbook name and delete extension
Filename = ActiveWorkbook.Name
If InStr(Filename, ".") > 0 Then
Filename = Left(Filename, InStr(Filename, ".") - 1)
End If
'clear header & footer
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
'get worksheet name
With ActiveSheet.PageSetup
If InStr(Filename, ".") > 0 Then
Filename = Left(Filename, InStr(Filename, ".") - 1)
End If
'remove text config file
Sheets("Cover").Range("c5").Copy Destination:=Sheets("Smartpack-S").Range("f3")
Sheets("Smartpack-S").Range("f3").Replace what:="Config File", Replacement:=" - V2A", LookAt:=xlPart, MatchCase:=False
Sheets("Cover").Range("c5").Copy Destination:=Sheets("Smartpack-S").Range("f5")
Sheets("Smartpack-S").Range("f5").Replace what:="Config File", Replacement:=" - V2A", LookAt:=xlPart, MatchCase:=False
'change row colour
'Range("f3:f5").Interior.Color = RGB(255, 255, 204)
'row height
Rows("3:1").RowHeight = 19
Rows("5:1").RowHeight = 19
'what goes into the header and footers
.RightHeader = "&B&16" & Sheets("Smartpack-S").Range("f3 ").Value & Chr(10) & "&16&A" & Chr(10) '" Settings"
Filename = ActiveWorkbook.Name
If InStr(Filename, "_") > 0 Then
Filename = Left(Filename, InStr(Filename, "_") - 1)
End If
.LeftFooter = Chr(10) & Chr(10) & Chr(10) & Chr(10) & "&B&16" & "Drawing Number: " & Filename
.RightFooter = Chr(10) & "&B&16" & "&d" & Chr(10) & "Page :" & " " & "&P" & " of " & "&N"
'add logo to left header
With ActiveSheet.PageSetup.LeftHeaderPicture
.Filename = "D:\logo.jpg"
.Height = 30
'.Width = 400 .Brightness = 0.36
'.ColorType = msoPictureGrayscale
'.Contrast = 0.39
End With
ActiveSheet.PageSetup.LeftHeader = "&G"
End With
Application.ScreenUpdating = True
End Sub
Print module
Sub PrintAll()
CurrentSheet = ActiveSheet.Name
'If fleximonitor sheet is showing
If Sheets("fleximonitor").Visible = True Then
Sheets(Array("Cover", "Description", "Smartpack-S", "fleximonitor")).PrintPreview 'Print only 4 sheets
'If only 4 sheets are showing
Else 'If Sheets("fleximonitor").Hidden = True Then
Sheets(Array("Cover", "Description", "Smartpack-S")).PrintPreview 'Print only 3 sheets
End If
End Sub
I have a separate module that with a button placed on what i call the cover page which allows me to print all active pages, so i would like to use this button to apply the headers/footers etc to all of the sheets in the workbook prior to print preview.
I cant figure out how to do this, any ideas?
Sub AddFooter()
'
' Adds Filename, Worksheet Name and Date (static or updated type) as Footer
'
Dim Response As Integer
Dim lenheader As String
Dim lenfooter As String
Dim wsSheet As Worksheet
Application.ScreenUpdating = False
' get workbook name and delete extension
Filename = ActiveWorkbook.Name
If InStr(Filename, ".") > 0 Then
Filename = Left(Filename, InStr(Filename, ".") - 1)
End If
'clear header & footer
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With
'get worksheet name
With ActiveSheet.PageSetup
If InStr(Filename, ".") > 0 Then
Filename = Left(Filename, InStr(Filename, ".") - 1)
End If
'remove text config file
Sheets("Cover").Range("c5").Copy Destination:=Sheets("Smartpack-S").Range("f3")
Sheets("Smartpack-S").Range("f3").Replace what:="Config File", Replacement:=" - V2A", LookAt:=xlPart, MatchCase:=False
Sheets("Cover").Range("c5").Copy Destination:=Sheets("Smartpack-S").Range("f5")
Sheets("Smartpack-S").Range("f5").Replace what:="Config File", Replacement:=" - V2A", LookAt:=xlPart, MatchCase:=False
'change row colour
'Range("f3:f5").Interior.Color = RGB(255, 255, 204)
'row height
Rows("3:1").RowHeight = 19
Rows("5:1").RowHeight = 19
'what goes into the header and footers
.RightHeader = "&B&16" & Sheets("Smartpack-S").Range("f3 ").Value & Chr(10) & "&16&A" & Chr(10) '" Settings"
Filename = ActiveWorkbook.Name
If InStr(Filename, "_") > 0 Then
Filename = Left(Filename, InStr(Filename, "_") - 1)
End If
.LeftFooter = Chr(10) & Chr(10) & Chr(10) & Chr(10) & "&B&16" & "Drawing Number: " & Filename
.RightFooter = Chr(10) & "&B&16" & "&d" & Chr(10) & "Page :" & " " & "&P" & " of " & "&N"
'add logo to left header
With ActiveSheet.PageSetup.LeftHeaderPicture
.Filename = "D:\logo.jpg"
.Height = 30
'.Width = 400 .Brightness = 0.36
'.ColorType = msoPictureGrayscale
'.Contrast = 0.39
End With
ActiveSheet.PageSetup.LeftHeader = "&G"
End With
Application.ScreenUpdating = True
End Sub
Print module
Sub PrintAll()
CurrentSheet = ActiveSheet.Name
'If fleximonitor sheet is showing
If Sheets("fleximonitor").Visible = True Then
Sheets(Array("Cover", "Description", "Smartpack-S", "fleximonitor")).PrintPreview 'Print only 4 sheets
'If only 4 sheets are showing
Else 'If Sheets("fleximonitor").Hidden = True Then
Sheets(Array("Cover", "Description", "Smartpack-S")).PrintPreview 'Print only 3 sheets
End If
End Sub