davis1118
11-20-2017, 01:02 PM
I have a file that has 5 work sheets that are all named differently. I have a macro that prints each sheet separately to a PDF on save, and uses the sheet name for each PDF filename. The last four sheets need to have "Insp. Sht" added before the filename, but the first sheet "Control Plan" does not need "Insp. Sht" added into the filename. I have been lost trying to figure this out and can't seem to find any good examples of what I need to do to accomplish this. I have turned to the wizards on this site, as they have helped me out before. Below is the code that I currently have running. I have a bunch of code adding in footers and saving backup copy's into an archive folder. I'm not sure if I should include everything or just the PDF part, but I have included the entire macro. I'm sorry if I should have only posted the PDF part.
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
If Not SaveAsUI Then
'FOOTER
Dim ws As Worksheet
For Each ws In Worksheets
ws.PageSetup.LeftFooter = "&8&""Arial""&F_" & Format(Date, "ddMmmyy")
ws.PageSetup.CenterFooter = "&8&""Arial""&P of &N"
Next ws
'SAVE AS PDF & BACKUP COPY
Dim folderPath As String
Dim myName As String
Dim ext As String
Dim backupdirectory As String
Dim nm As String
Dim T As String
folderPath = Application.ActiveWorkbook.Path
myName = InputBox("Please Input Filename for Backup Copy", "Backup Name")
ext = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, "."))
backupdirectory = "Archive"
T = Format(Now, "ddMmmyy")
For Each ws In Worksheets
ws.Select
nm = ws.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=folderPath & "\" & "Insp. Sht" & "_" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Next ws
Const CreateFolder = 2
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(ThisWorkbook.Path & "/" & backupdirectory) Then
fso.CreateFolder (ThisWorkbook.Path & "/" & backupdirectory)
End If
ThisWorkbook.SaveCopyAs folderPath & "\" & backupdirectory & "\" & myName & "_" & T & "." & ext
Else
End If
Application.EnableEvents = True
End Sub
Thank you for any help or suggestion! - David
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Application.EnableEvents = False
If Not SaveAsUI Then
'FOOTER
Dim ws As Worksheet
For Each ws In Worksheets
ws.PageSetup.LeftFooter = "&8&""Arial""&F_" & Format(Date, "ddMmmyy")
ws.PageSetup.CenterFooter = "&8&""Arial""&P of &N"
Next ws
'SAVE AS PDF & BACKUP COPY
Dim folderPath As String
Dim myName As String
Dim ext As String
Dim backupdirectory As String
Dim nm As String
Dim T As String
folderPath = Application.ActiveWorkbook.Path
myName = InputBox("Please Input Filename for Backup Copy", "Backup Name")
ext = Right(ThisWorkbook.Name, Len(ThisWorkbook.Name) - InStrRev(ThisWorkbook.Name, "."))
backupdirectory = "Archive"
T = Format(Now, "ddMmmyy")
For Each ws In Worksheets
ws.Select
nm = ws.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=folderPath & "\" & "Insp. Sht" & "_" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
Next ws
Const CreateFolder = 2
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")
If Not fso.FolderExists(ThisWorkbook.Path & "/" & backupdirectory) Then
fso.CreateFolder (ThisWorkbook.Path & "/" & backupdirectory)
End If
ThisWorkbook.SaveCopyAs folderPath & "\" & backupdirectory & "\" & myName & "_" & T & "." & ext
Else
End If
Application.EnableEvents = True
End Sub
Thank you for any help or suggestion! - David