I have the following VBA code:
Sub Button1_Click()
Const SAVE_PATH = "S:\Divisional Support\RVU Programs\Payroll 2015\2015-01 January\Provider Performance PDF's"
Dim cell As Range
Dim wsSummary As Worksheet
Dim counter As Long
Set wsSummary = Sheets("PERFORMANCE ANALYSIS")
For Each cell In Worksheets("MEMORIAL HOSPITAL OF YORK").Range("$A$200:$A$226")
If cell.Value <> "" Then
'progress in status bar
counter = counter + 1
Application.StatusBar = "Processing file: " & counter & "/1042"
With wsSummary
.Range("$A$6").Value = cell.Value
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=cell.Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End If
Next cell
Set wsSummary = Nothing
End Sub
For some reason I can't explain it not saving in location : S:\Divisional Support\RVU Programs\Payroll 2015\2015-01 January\Provider Performance PDF's
Instead it's saving : S:\Divisional Support\RVU Programs\Payroll 2015\MOCK Folder for Ryan
Any help will be appreciated!
You are not using SAVE_PATH variable in export part. Try:
Filename:= SAVE_PATH & "\" & cell.Value & ".pdf"
Related
I keep getting a runtime error on this line:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=MgrPath & "2018 Mid-Year Comp Statement - " & SM.Range("C5").Value & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Sub Statement_Autoprint()
Dim MCST As Workbook: Set MCST = ActiveWorkbook
Dim User As String: User = Environ$("Username")
Dim SavePath As String: SavePath = "M:\comp_statements\"
Dim CS As Worksheet: Set CS = MCST.Sheets("Control Sheet")
Dim MgrPath As String, MyCell As Range, Printed As Integer, i As Integer, SM As Worksheet
Printed = 0
Call Disable
For i = 2 To CS.Range("B" & CS.Rows.Count).End(xlUp).Row
If CS.Range("A" & i) <> "" & CS.Range("B" & i) <> "" Then
Set SM = MCST.Sheets(CStr(CS.Range("A" & i)))
SM.Calculate
SM.Range("P1") = Format(CS.Range("B" & i), "000000000")
For Each MyCell In SM.Range("N2:N70")
If MyCell = "HIDE" Then
MyCell.EntireRow.Hidden = True
ElseIf MyCell <> "HIDE" Then
MyCell.EntireRow.Hidden = False
End If
Next MyCell
If Not Application.CalculationState = xlDone Then
DoEvents
End If
MgrPath = "M:\Pittsburgh\GRP4\HR_PCorpComp\2018 Midyear\Reporting\Parsley\comp_statements\" & SM.Range("K5") & "\"
If Dir(MgrPath, vbDirectory) <> "" Then
MkDir MgrPath
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=MgrPath & "2018 Mid-Year Comp Statement - " & SM.Range("C5").Value & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Printed = Printed + 1
End If
Next i
CS.Activate
Call Re_Enable
End Sub
I do not have any files that exist/are open under that name, I have no clue what could be preventing this from saving. All of the other bits of code do what they're supposed to, it just can't loop to the next employee because the save is being suppressed because of that error.
Try this
For Each mycell In SM.Range("N2:N70")
If IsError(mycell) Then
Debug.Print mycell.Address
Else
mycell.EntireRow.Hidden = (mycell = "HIDE")
End If
Next mycell
Either handle the error using IsError or
Go to the cell which the above code points to and check if there are any formula errors.
You usually get that error if the cell has formula errors.
Could someone please tell me what I am doing wrong, I am pretty new to VBA and have the following code. I want to open several excel files and save the "Cash" tab as a pdf to a specific folder. The problem I am having is that it tries to save the folder to the "Test" folder and not the folder indicated by the "Cells(r,3)" so I get an error after it saves the first PDF file because they have the same name. Any help would be appreciated!
Sub Cash_PDF_()
r = 2
Do While Cells(r, 5) <> ""
Workbooks.Open FileName:="H:\Investment\Fund Folders\" & Cells(r, 3) & "\" & Cells(r, 5), _
ReadOnly:=True, UpdateLinks:=0
Sheets("Cash").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:="C:\Users\Desktop\Test\" & Cells(r, 3) & "\Cash.pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
ActiveWindow.Close SaveChanges:=False
r = r + 1
Loop
End Sub
Cells, when unqualified, refers to the active sheet. You change the active sheet, so it isn't referring to what you intended.
Sub Cash_PDF_()
Dim ws As Worksheet
Dim wb As Workbook
Dim r As Long
Set ws = ActiveSheet
r = 2
Do While ws.Cells(r, 5) <> ""
Set wb = Workbooks.Open(FileName:="H:\Investment\Fund Folders\" & ws.Cells(r, 3) & "\" & ws.Cells(r, 5), _
ReadOnly:=True, UpdateLinks:=0)
wb.Sheets("Cash").ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:="C:\Users\Desktop\Test\" & ws.Cells(r, 3) & "\Cash.pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
wb.Close SaveChanges:=False
r = r + 1
Loop
End Sub
I am printing worksheets to one single PDF file with one chunk of code. With this PDF file open, If I attempt another print to PDF from this same excel file I get a VB error: "Document not saved" and debug takes me here in the code:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
strFilename & " " & wedate_text & " Time", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
HERE IS CODE:
Sub PrintAnadarkoTicketsToPDF()
Worksheets("Cover").Visible = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayStatusBar = False
Application.EnableEvents = False
Dim strFilename As String
Dim rngRange As Range
Dim wedate As Date
Dim wedate_text As String
Set rngRange = Worksheets("Cover").Range("A5")
strFilename = rngRange.Value
wedate = Worksheets("Cover").Range("B24").Value
wedate_text = Format$(wedate, "mm.dd.yyyy")
Dim myArray() As Variant
Dim i As Integer
Dim j As Integer
j = 0
For i = 1 To Sheets.Count
If Sheets(i).Visible = True Then
ReDim Preserve myArray(j)
myArray(j) = i
j = j + 1
End If
Next i
Sheets(myArray).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:= _
strFilename & " " & wedate_text & " Time", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
Worksheets("Cover").Visible = True
Sheets(1).Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayStatusBar = True
Application.EnableEvents = True
End Sub
My question is: How do I print this second PDF without crashing the script? I would like to close the previous PDF or create the second PDF with a different file name. Thanks for the suggestions.
Randy
I'm not sure why you want to have a loop that counts the number of non-hidden sheets. Plus, you could export the sheets inside that loop. That may fix your issue:
For i = 1 To Sheets.Count
If Sheets(i).Visible = True Then
Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, filename:= _
strFilename & Trim(Str(i)) & " " & wedate_text & " Time", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End If
Next i
Note also the addition of the workbook number to the file name, because it's trying to save to the same file.
i am an amateur programmer learning how to program using vba
without further a due, my question is :
i have created a listbox (listbox1) where i've listed all my sheets(ws) name in a specific workbook.
i've also created another listbox(listbox2) where when i select some sheets name on the listbox1, they will be transfer to listbox2.
my main objective is that by choosing one or more sheets listed in the listbox2, and by clicking a button, i'll manage to save all the selected sheets in one pdf file.
here is the code for the button used to export the file in pdf that i've written but i've only managed to export them not in one pdf file but in numerous amount of pdf file.
Dim NomTableau() As String
For Each WkbkName In application.Workbooks()
If WkbkName.Name = choix_poteau.Value & "_" & section & "_" & projet & ".xlsx" Then
WkbkName.Activate
GoTo lois
End If
Next
Set wbk = Workbooks.Open(add1 & "\" & Me.projet.Value & "\" & Me.section.Value & "\poteaux\" & Me.choix_poteau.Value & "_" & Me.section & "_" & Me.projet & ".xlsx")
lois:
For i = 0 To ListBox2.ListCount - 1
While ListBox2.List(i) <> ""
Dim ws As Worksheet
For Each ws In Worksheets
If ws.Name = ListBox2.List(i) Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Export\Resultats__" & ListBox2.List(i - counter) & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End If
Next
Wend
Next i
End Sub
thanks alot, really appreciate your help
Instead of exporting each sheet individually, select them all first and then call the ExportAsFixedFormat method.
Here is my test code, which worked as expected:
Option Explicit
Private Sub TestPDF()
Dim i As Integer
Dim arrSheets() As String
Dim strSheets As String
'Get our sheet names
For i = 1 To 3
strSheets = Worksheets(i).Name & "," & strSheets
Next
'Trim the trailing comma
strSheets = Left(strSheets, Len(strSheets) - 1)
arrSheets = Split(strSheets, ",")
ThisWorkbook.Sheets(arrSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\qzbcjs\Documents\Useful Workbooks\test.pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
End Sub
I declared an array of strings, populated a string variable with the comma-delimited names of the worksheets (in my case I just wanted the first through third sheets), split that comma-delimited string into an array and used the array to select all of the desired sheets and only called the ExportAsFixedFormat method once.
Adapting this method to your code, beginning as the lois part would look something like this:
lois:
Dim ws As Worksheet
Dim arrSheets() As String
Dim strWs As String
For i = 0 To ListBox2.ListCount - 1
While ListBox2.List(i) <> ""
For Each ws In Worksheets
If ws.Name = ListBox2.List(i) Then
strWs = ws.Name & "," & strWs
End If
Next
Wend
Next i
strWs = Left(strWs, Len(strWs) - 1)
arrSheets = Split(strWs, ",")
ThisWorkbook.Sheets(arrSheets).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Export\Resultats__" & ListBox2.List(i - counter) & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
True
I have the following code:
Const SAVE_PATH = "S:\Divisional Support\RVU Programs\Payroll 2015\2015-04 April\PDF's\Baptist Easley"
'paste file destination in the above location'
Dim cell As Range
Dim wsSummary As Worksheet
Dim counter As Long
Set wsSummary = Sheets("PERFORM. SUM. - EASLEY")
For Each cell In Worksheets("NAME KEY").Range("$H:$H")
If cell.Value <> "" Then
'progress in status bar
counter = counter + 1
Application.StatusBar = "Processing file: " & counter & "/1042"
With wsSummary
.Range("$A$4").Value = cell.Value
.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=SAVE_PATH & "\" & cell.Value & ".pdf", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End If
Next cell
Set wsSummary = Nothing
End Sub
My issue is simple instead of having to step into the code to change the location where it's saved: Const SAVE_PATH = "S:\Divisional Support\RVU Programs\Payroll 2015\2015-04 April\PDF's\Baptist Easley"
I want to be able to post that location in cell J2, how will I code that?
I want to be able to post that location in cell J2, how will I code that?
It's very simple actually
Replace the line
FileName:=SAVE_PATH & "\" & cell.Value & ".pdf"
with
FileName:=Thisworkbook.Sheets("Sheet1").Range("J2").Value & _
"\" & cell.Value & ".pdf"
Change the Thisworkbook and Sheet1 to the relevant workbook or sheet.