TylerH
TylerH

Reputation: 21

Save to PDF loop not working

Solved.

The macro loops through a table and autofills values into the destination sheet and automatically saves as a pdf on the desktop with a specified file name for each row. It does not save them into a single pdf; however, if you have adobe acrobat it has a simple merge tool to combine them together.

  Sub AutoFill_export2pdf()
'

Dim rowCount As Integer
Dim CurBU As String
Dim CurOPRID As String
Dim CurName As String
Dim CurJournalID As String
Dim CurJournalDate As String
Dim FILE_NAME As String

 Sheets("List").Select

rowCount = ActiveSheet.UsedRange.Rows.count

Set Destsh = ActiveWorkbook.Sheets("Sheet")

For sourceRow = 2 To rowCount

CurOPRID = Range("A" & CStr(sourceRow)) 'OPRID
CurName = Range("B" & CStr(sourceRow)) 'Name
CurBU = Range("C" & CStr(sourceRow)) 'BU
CurJournalID = Range("D" & CStr(sourceRow)) 'Journal ID
CurJournalDate = Range("E" & CStr(sourceRow)) 'Journal Date

FILE_NAME = ActiveWorkbook.Path & "\" & "OTGL_" & "JRNL_" & CurBU & "_" &     CurJournalID & "_" & Format(CurJournalDate, "mm-dd-yyyy") & "_" & ".PDF"
CurName = "*" & CurName & "*"
CurBU = "*" & CurBU & "*"
CurJournalID = "*" & CurJournalID & "*"
CurJournalDate = "*" & CurJournalDate & "*"

Destsh.Range("K27") = CurName
Destsh.Range("D7") = CurBU
Destsh.Range("G7") = CurJournalID
Destsh.Range("I7") = CurJournalDate

On Error GoTo 0

Call SaveAsPDF(Destsh, FILE_NAME)

Sheets("List").Select

Next

End Sub


Public Sub SaveAsPDF(ByVal destSheet As Worksheet, ByVal PDFName As String)


On Error Resume Next
Kill PDFName

destSheet.Activate

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
        PDFName, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False,   OpenAfterPublish:=False

End Sub


Sub Autofill()
'

Dim rowCount As Integer
Dim CurBU As String
Dim CurName As String
Dim CurOPRID As String
Dim CurJournalID As String
Dim CurJournalDate As String
Dim FILE_NAME As String

CurName = "*" & CurName & "*"
CurBU = "*" & CurBU & "*"
CurJournalID = "*" & CurJournalID & "*"
CurJournalDate = "*" & CurJournalDate & "*"

Sheets("List").Select

rowCount = ActiveSheet.UsedRange.Rows.count

Set Destsh = ActiveWorkbook.Sheets("Sheet")

For sourceRow = 2 To rowCount

CurOPRID = Range("A" & CStr(sourceRow)) 'OPRID
CurName = Range("B" & CStr(sourceRow)) 'Name
CurBU = Range("C" & CStr(sourceRow)) 'BU
CurJournalID = Range("D" & CStr(sourceRow)) 'Journal ID
CurJournalDate = Range("E" & CStr(sourceRow)) 'Journal Date

FILE_NAME = ActiveWorkbook.Path & "\" & "OTGL_" & "JRNL_" & CurBU & "_" &    CurJournalID & "_" & Format(CurJournalDate, "mm-dd-yyyy") & "_" & ".PDF"

Destsh.Range("K27") = CurName
Destsh.Range("D7") = CurBU
Destsh.Range("G7") = CurJournalID
Destsh.Range("I7") = CurJournalDate

On Error GoTo 0

Call SaveAsPDF(Destsh, FILE_NAME)



Sheets("List").Select



Next


End Sub


End Sub

Upvotes: 0

Views: 454

Answers (1)

gtwebb
gtwebb

Reputation: 3011

You want to export just the Destination sheet (Destsh). So use

Destsh.ExportAsFixedFormat Type:=xlTypePDF, _
               filename:="fp", _
               Quality:=xlQualityStandard, _
               IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=False

Instead of

wb.ExportAsFixedFormat Type:=xlTypePDF, _
               filename:="fp", _
               Quality:=xlQualityStandard, _
               IncludeDocProperties:=True, _
               IgnorePrintAreas:=False, _
               OpenAfterPublish:=False

Also this will just save the file to "fp" you want to use something like

filename:= fp & "\mysheetname.pdf"

Upvotes: 1

Related Questions