learningvbanewbie
New Member
- Joined
- Jul 24, 2024
- Messages
- 1
- Office Version
- Prefer Not To Say
Hi Everyone, I am trying to fit all columns into one page wide but with hidden columns, it is pagebreak into other pages, the same goes with hidden rows too, is there anyway to fix it?, Below are my vba code
VBA Code:
Function ReplaceInvalidFileNameChars(fileName As String) As String
Dim invalidChars As String
invalidChars = "\/:*?""<>|"
Dim i As Integer
For i = 1 To Len(invalidChars)
fileName = Replace(fileName, Mid(invalidChars, i, 1), "")
Next i
ReplaceInvalidFileNameChars = fileName
End Function
Sub ExportToPDFtesting()
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Dim filterValue As String
Dim driverName As String
Dim outputPath As String
Dim fileName As String
Dim previousMonthDate As Date
Dim previousMonth As String ' Define previousMonth
Dim exportRange As Range ' Define exportRange
' Turn off screen updating and disable alerts temporarily
Application.ScreenUpdating = False
Application.DisplayAlerts = False
' Specify the worksheet where your data is located (e.g., "Aurora")
Set ws = ThisWorkbook.Sheets("Aurora")
' Page Setup (outside the inner loop)
With ws.PageSetup
.Orientation = xlLandscape
.PaperSize = xlPaperA4
.Zoom = False
.FitToPagesWide = 1 ' Fit all columns on one page width
.FitToPagesTall = False ' Set to False to allow dynamic page tall setting
End With
' Specify the output folder path where PDFs will be saved
outputPath = ThisWorkbook.path ' Update with your desired path
' Get the previous month in format "mmm yy"
previousMonthDate = DateSerial(Year(Date), Month(Date), 1)
previousMonthDate = DateAdd("m", -1, previousMonthDate)
previousMonth = Format(previousMonthDate, "mmm'yy")
' Loop through unique driver codes and filter data
For Each cell In ws.Range("Y2:Y" & ws.Cells(ws.Rows.Count, "Y").End(xlUp).Row)
filterValue = cell.Value
' Check if filter value is not empty
If filterValue <> "" Then
' Apply filter to Driver Code column (Column Y)
ws.Range("Y:Y").AutoFilter Field:=1, Criteria1:=filterValue
' Loop through visible cells in column Z to get driver name
For Each rng In ws.Range("Z2:Z" & ws.Cells(ws.Rows.Count, "Z").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
driverName = rng.Value
' Check if driverName is not empty
If driverName <> "" Then
' Replace invalid characters in filename
fileName = ReplaceInvalidFileNameChars(filterValue & " " & driverName & " - " & previousMonth)
' Define the range to export (excluding headers, filtered by driver code)
Set exportRange = ws.Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible)
' Export to PDF with specified settings
exportRange.ExportAsFixedFormat Type:=xlTypePDF, _
fileName:=outputPath & fileName & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
Next rng
' Clear filter
ws.AutoFilterMode = False
End If
Next cell
' Turn on screen updating and enable alerts
Application.ScreenUpdating = True
Application.DisplayAlerts = True
' Show message box when process is complete
MsgBox "PDF has been exported successfully!", vbInformation
End Sub