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
Related
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 have a folder with several excel workbooks that I need to export to pdf. There is a logo (.bmp) on each sheet of each workbook. When I use the below code, the pdfs are all missing the logo (it has a grey placeholder instead) on ONLY the first page. The rest of the pages have the logo.
My code:
Option Explicit
Sub dsPdf()
Dim path As String
Dim wbName As String
Dim tWb As Workbook
Dim t As Single
path = ThisWorkbook.path
wbName = Dir(path & "\*.xlsx")
Application.ScreenUpdating = True
Do While wbName <> ""
Set tWb = Workbooks.Open(path & "\" & wbName)
tWb.Sheets(Array(1, 2, 3)).Select
DoEvents
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
path & "\" & Left(wbName, Len(wbName) - 4) & "pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
tWb.Close False
wbName = Dir
Loop
End Sub
I've tried using ActiveSheet.RefreshAll and DoEvents, as well as adding a Timer/Do While loop. When I put Stop before the export statement, the first sheet shows the logo correctly. However when I put Aplication.Wait(Now... the logo does not show.
Any ideas?
Thanks
Try this - I avoided the use of .Select, as (I'm not sure) but I think that could be causing some issues.
Sub dsPdf_NoSelect()
Dim path As String
Dim wbName As String
Dim tWb As Workbook
Dim t As Single
Dim i As Long
path = ThisWorkbook.path
wbName = Dir(path & "\*.xlsx")
Application.ScreenUpdating = True
Do While wbName <> ""
Set tWb = Workbooks.Open(path & "\" & wbName)
For i = 1 To 3
tWb.Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, Filename:=path & "\" & Left(wbName, Len(wbName) - 4) & "pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Next i
tWb.Close False
wbName = Dir
Loop
End Sub
I'm fairly green with using VBA and this is the first time I've posted a question in this forum so bear with me if I'm breaking any posting rules.
Below is a piece of code I use to print/save 1 or more worksheets from an Excel workbook to PDF. It works fine if the data from each worksheet that I'm exporting fits onto a single page. The problem I'm finding is that if the range of data from my first sheet is larger than 1 page then only the 1st worksheet will be exported, and only up to the first page-break. Any advice or suggestions on how I can resolve this issue?
'Ask user if report needs to be saved as a pdf
PdfCheck = MsgBox("Save report as PDF", vbYesNo, "Save PDF")
'use result of <PdfCheck> to control if statement
If PdfCheck = vbYes Then
Pdfsheets = InputBox("How many worksheets would you like to include in PDF")
'Prints the number of sheets entered by user
'starts at first ACTIVE Worksheet to the result of <Pdfsheets>
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"C:\Users\" & WinName & "\Documents\REPORTING\" & Database & "\" & _
ReportYear & "\" & FolderMonth & "\" & Database & "-" & Title & "-" & FileDate _
, Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, From:=1, To:=Pdfsheets, OpenAfterPublish:=True
Else
GoTo X
End If
X:
End Sub
The method I use, is to loop through the worksheets within the workbook and select the ones that meet my criteria. Then I use ExportAsFixedFormat to create my pdf.
Note you cannot select hidden worksheets, so if the workbook contains them you will need to add an if/then to check visibility.
Pdfsheets = InputBox("How many worksheets would you like to include in PDF")
for x=1 to Pdfsheets
thisworkbook.sheets(x).select (false) 'use false to select multiple sheets
next x
'Prints the number of sheets entered by user--starts at first ACTIVE
Worksheet to the result of <Pdfsheets>
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _
"C:\Users\" & WinName & "\Documents\REPORTING\" & Database & "\" & ReportYear & "\" & FolderMonth & "\" & Database & "-" & Title & "-" & FileDate _
, Quality:=xlQualityStandard, IncludeDocProperties:=False, _
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.
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"