VBA for Page Setup for Multiple Worksheets

AvgMSUser

New Member
Joined
Dec 22, 2015
Messages
8
Can someone let me know if I am taking the best approach? I have a workbook with 24 worksheets, all requiring unique bottom margins and scale settings. I need the users to print and create pdf versions of the worksheets they use with a consistent appearance so I plan to apply a Private Sub for each worksheet to trigger the formatting if the worksheet is used.
</SPAN>
This is my first time working with VBA for page setup formatting so all advice is appreciated.</SPAN>
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,797
- What Excel version are you using?
- It can be done with a single routine:

Code:
' ThisWorkbook module
' tested with Excel 2013
Dim formatted() As Boolean, i%


Private Sub Workbook_Open()
ReDim formatted(1 To Me.Worksheets.Count)
For i = 1 To Me.Worksheets.Count
    formatted(i) = 0
Next
End Sub


Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim sn
sn = Evaluate("=sheet(""" & Sh.Name & """)")
If Not formatted(sn) Then
    Sh.PageSetup.BottomMargin = Application.InchesToPoints(1)
    Sh.PageSetup.FitToPagesWide = 1
    formatted(sn) = 1
End If
End Sub
 

AvgMSUser

New Member
Joined
Dec 22, 2015
Messages
8
I have been doing further research to create a code that will: 1) make the Save as window appear and 2) save all visible worksheets except the ones names “U.S.” and “Canadian” as one PDF document</SPAN>
I am not skilled enough to utilize Booleans in my code so I tried to combine my simple Print code with another I found but it isn’t working. Am I completely off the mark trying to get the below code to work?</SPAN>
Code:
Sub SavePDF()</SPAN>
' Save file as pdf</SPAN>
    Dim i As Variant</SPAN>
    Dim wSheet As Worksheet</SPAN>
For Each wSheet In ActiveWorkbook.Worksheets</SPAN>
If wSheet.Visible = xlSheetVisible Then</SPAN>
    If wSheet.Name <> "U.S." Then</SPAN>
    If wSheet.Name <> "Canadian" Then</SPAN>
i = Application.GetSaveAsFilename("Last Name First Name", "PDF Files (*.pdf), *.pdf")</SPAN>
If VarType(i) = vbString Then</SPAN>
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=i, _</SPAN>
    Quality:=xlQualityStandard, IncludeDocProperties:=True, _</SPAN>
    IgnorePrintAreas:=False, OpenAfterPublish:=False</SPAN>
    End If</SPAN>
    End If</SPAN>
End If</SPAN>
   
End Sub</SPAN>
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,797
See if this does what you want:

Code:
Sub Some_to_PDF()
Dim sarr, i%, j%, sh As Worksheet
ReDim sarr(0 To ThisWorkbook.Worksheets.Count - 3)  ' array of sheet names
j = 0
For i = 1 To ThisWorkbook.Worksheets.Count
    Set sh = Sheets(i)
    If sh.Name <> "U.S." And sh.Name <> "Canadian" And sh.Visible Then
        sarr(j) = sh.Name
        j = j + 1
    End If
Next
Sheets(sarr).Select     ' only desired sheets
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\avg.pdf"
Sheets(1).Activate
End Sub
 

AvgMSUser

New Member
Joined
Dec 22, 2015
Messages
8
Hi Worf,

I tried the code but received the error "Runt-time error '9': Subscript out of Range". The error appears to be occuring at row: Sheets(sarr).Select ' only desired sheets.

Thanks for continuing to help me with this.
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,797
Hi

That code worked for me. Please test this other one, replacing the sheet names where indicated.
You can use any number of sheets on that line, up to a reasonable limit.

Code:
Sub Typing_Names()
Sheets(Array("Sheet1", "Sheet2")).Select    ' your sheet names here
ActiveSheet.ExportAsFixedFormat xlTypePDF, ThisWorkbook.Path & "\avgtest.pdf"
End Sub
 

Forum statistics

Threads
1,081,518
Messages
5,359,237
Members
400,523
Latest member
ExcelNewbie98

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top