Hello,
I need some help to improve this macro, so it 1) removes any invalid strings, and 2) save an extra sheet in case cell B10 contains either "6777" or "6780" values:
To make it easier, the required changes are marked in red:
Thanks in advance!
---------
Sub Save_pdf()
Dim c As Range, cps As Long, i As Long
Application.DisplayAlerts = False
For Each c In Selection
Sheets("Info").Range("Q10").Value = c.Value
'Remove any invalid strings \/:*?"<>| from cell B2 to save as a valid filename
p = Sheets("Info").Range("B2")
a = Sheets("Info").Range("T9")
Dim rw As Range
For Each rw In Rows("8:16")
If rw.RowHeight <> 0 Then
rw.EntireRow.AutoFit
End If
Next rw
'If cell C10 is NOT 6777 or C10 is NOT 6780
With Sheets("Info")
.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"F:\DOF\do\2015\Disp\" & p & " - PC " & c & " - EX" & a & " - " & Format(Now, "yyyymmddhhmmss") & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
'If cell C10 is 6777 or C10 is 6780
Sheets(Array("Info", "Ger")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="F:\DOF\do\2015\Disp\" & p & " - PC " & c & " - EX" & a & " - " & Format(Now, "yyyymmddhhmmss") & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=False, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Next c
Application.DisplayAlerts = True
End Sub
Bookmarks