PDA

View Full Version : How to change code for sheet to work whole book



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

SamT
04-29-2018, 08:31 AM
Dim Sht as WorkSheet

'Move filename and Config parts of code outside loop
For each Sht in Sheets
'Replace "ActiveSheet" in Code with "Sht"

'Add Headers and Footers code here
Next

Paul_Hossler
04-29-2018, 02:14 PM
i have this "Addfooter" code placed in the "Thisworkbook" area. But

I think it belongs in a standard module, especially after you add SamT's code