All,
I have been able to achieve what I want. Except being able to exclude printing Sheet 1 when I pdf print the workbook. Any suggestion would help. I am still a noobie so if you see anything that may make this better please let me know.
Sub ExportToPDFs()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
nm = ws.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Procal Calibration Sheets\" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next ws
YesNo = MsgBox("Open folder where the Calibration Sheets are saved?" _
, vbYesNo + vbQuestion, "Open Folder?")
Select Case YesNo
Case vbYes
myval = Shell("explorer C:\Procal Calibration Sheets\" & FolderName, 1)
Case vbNo
End Select
End Sub
Just exclude with an IF your sheet
For Each ws In Worksheets
If ws.Name <> "Sheet1" Then 'name of the sheet you want to exclude
ws.Select
nm = ws.Name
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="C:\Procal Calibration Sheets\" & nm & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
End If
Next ws
Related
I try to set up a code that will save a excelworksheet in a workbook as a PDF and will extract one other worksheet and saves that one under a different name in the same location. atm my code works except for the part that it saves the file not always to the right location.
I use an excel formula to get the right filepath in cell "Dimensionering!I8". I save the worksheet in the same location as the workbook is allready saved.
In the second part of the code I copy a worksheet to a new workbook so I linked the filepath from the worksheet 'dimensionering' to the worksheet 'offertetekst'.
Sub SAVE()
Dim filename As String
Dim filename1 As String
filename = Range("Dimensionering!C8")
Sheets("offerte stuklijst").Select
ActiveSheet.Range("$A$18:$A$1731").AutoFilter Field:=1, Criteria1:="1"
ActiveWindow.SmallScroll Down:=6
Chdir Range("Dimensionering!I8")
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=filename & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
filename1 = Range("Offerte_tekst!E1491")
Sheets("Offerte_tekst").Select
Sheets("Offerte_tekst").Copy
Chdir Range("Offerte_tekst!E1492")
ActiveWorkbook.SaveAs filename:=filename1 & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
End Sub
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=Sheets("Dimensionering").Range("I8").Value & "\" & filename & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
ActiveWorkbook.SaveAs filename:=Sheets("Offerte_tekst").Range("E1492").Value & "\" & filename1 & ".xlsx" _
, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
This assumes you don't have backslash in your path cell Dimensionering!I8
I need to get both of these sheets and ranges to be combined into ONE PDF. I have tried all of the macros I can find and none of them work. Here is the Macro I'm working with, which all works except for the ranges being combined in one Doc
Private Sub SaveLHForms()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
FormName = Sheets("SETUP").Range("B2").Value & " " & ActiveSheet.Range("S1") & ".pdf"
ChDir DesktopAddress
Sheets("Lienholder Docs").Range("A45:I151").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Sheets("Settlement Letters").Range("A47:I92").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
First, you need to create a pdf document after setting the print area in the page settings of each sheet.
Sub test()
Dim path As String
Dim myArr As Variant, a As Variant
Dim rngArr As Variant
Dim Ws As Worksheet
Dim formName As String
Dim i As Integer
formName = Sheets("SETUP").Range("B2").Value & " " & ActiveSheet.Range("S1") & ".pdf"
myArr = Array("Lienholder Docs", "Settlement Letters") '<~~ Sheet name
rngArr = Array("A45:I151", "A47:I92") '<~~ print area address
For i = 0 To UBound(myArr)
Set Ws = Sheets(myArr(i))
With Ws
.PageSetup.PrintArea = .Range(rngArr(i)).Address
End With
Next a
Sheets(myArr).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
formName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
This may work:
Sub Macro1()
Sheets("Lienholder Docs").Activate
ActiveSheet.Range("A45:I151").Select
Sheets("Settlement Letters").Activate
ActiveSheet.Range("A47:I92").Select
Sheets(Array("Lienholder Docs", "Settlement Letters")).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
End Sub
Based on:
Excel VBA to Export Selected Sheets to PDF
EDIT#1:
This version should un-do any grouping:
Sub Macro2()
Dim s As Worksheet
Set s = ActiveSheet
FormName = "C:\TestFolder\xxx.pdf"
Sheets("Lienholder Docs").Activate
ActiveSheet.Range("A45:I151").Select
Sheets("Settlement Letters").Activate
ActiveSheet.Range("A47:I92").Select
Sheets(Array("Lienholder Docs", "Settlement Letters")).Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
FormName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
s.Activate
End Sub
I have a macro that creates individual PDFs for a set of tabs. Is there a way to add a step and combine all the PDFs into one file?
Sub Print_Exhibit()
Dim Numb_Exhibit As Double
Dim File_Location As String
Dim Sheet_Name As String
Dim X As Double
Dim Y As Double
Numb_Exhibit = WorksheetFunction.Max(Sheets("Control - Exhibit
Key").Range("B:B"))
File_Location = Sheets("Control - Exhibit Key").Range("K6").Value
For X = 1 To Numb_Exhibit
Y = 8 + X
Sheet_Name = Sheets("Control - Exhibit Key").Range("E" & Y).Value
Sheets(Sheet_Name).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, filename:=File_Location
& "\" & Sheet_Name & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True,
IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Next
End Sub
Thank you so much for your help!
Loop through all tabs, copy and paste into a new common tab. Export it.
Did you do a prerequisite Google search before posting here?
Save multiple sheets to .pdf
Public Sub subCreatePDF()
If Not IsPDFLibraryInstalled Then
'Better show this as a userform with a proper link:
MsgBox "Please install the Addin to export to PDF. You can find it at http://www.microsoft.com/downloads/details.aspx?familyid=4d951911-3e7e-4ae6-b059-a2e79ed87041".
Exit Sub
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ActiveWorkbook.Path & Application.PathSeparator & _
ActiveSheet.Name & " für " & Range("SelectedName").Value & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub
Private Function IsPDFLibraryInstalled() As Boolean
'Credits go to Ron DeBruin (http://www.rondebruin.nl/pdf.htm)
IsPDFLibraryInstalled = _
(Dir(Environ("commonprogramfiles") & _
"\Microsoft Shared\OFFICE" & _
Format(Val(Application.Version), "00") & _
"\EXP_PDF.DLL") <> "")
End Function
OR
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\tempo.pdf", Quality:= xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
ALSO
https://danwagner.co/how-do-i-save-multiple-sheets-as-a-single-pdf/
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 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