I have a macro to generate excel into PDF. How do i add text box in the PDF at a specific location?
Here are my codes:
Sub Export()
Dim wsA As Worksheet
Dim wsB As Workbook
Dim strPath As String
Dim myFile As Variant
Set wbA = ActiveWorkbook
Set wsA = ActiveWorksheey
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
myFile = Application.GetSaveAsFilename _
(FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
wsa.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard,_
IncludeDocProperties:=True,_
IgnorePrintAreas:=False,_
OpenAfterPublish:=True
End If
End Sub
Thanks!
Related
I am trying to export Excel files to another folder as PDFs. The macro is stored in a separate .xlsm that I have open, and I directed the code to the folder with all the files that need to be PDFs.
The code only exports the first PDF in the folder. The error I got was that it could not operate in Page Break Mode, so I set it to normal mode for running the code but I still get the error.
Beyond that, it is reading the workbook that I have the macro stored in as a second active window. I ran the code to export to PDF on a single PDF and it worked as expected.
Option Explicit
Sub PPG_PDF_File()
'Below is used to make code run faster
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim wkbDest As Workbook
Dim wkbSource As Workbook
Set wkbDest = ThisWorkbook
Dim strExtension As String
Dim wsA As Worksheet
Dim strName As String
Dim strName1 As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Const strPath1 As String = "C:\Users\steve.argen\Documents\PPG\GW Sampling March 2020\PPG Balogna NUMBER 2\Final excel sheets\Test Macro Folder DNAPL Wells\"
ChDir strPath1
strExtension = Dir(strPath1 & "*.xls*")
Do While strExtension <> ""
Set wkbSource = Workbooks.Open(strPath1 & strExtension)
With wkbSource.Sheets("LowFlow GW front")
ActiveWindow.View = xlNormalView
On Error GoTo errHandler
Set wkbSource = ActiveWorkbook
Set wsA = ActiveSheet
'get active workbook folder, if saved
strPath = wkbSource.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = wsA.Range("A1").Value _
& " - " & wsA.Range("A2").Value _
& " - " & wsA.Range("A3").Value
'create default name for savng file
strFile = wkbSource.Name & ".pdf"
strFile = Replace(strFile, ".xlsx", "")
strPathFile = "C:\Users\steve.argen\Documents\PPG\GW Sampling March 2020\PPG Balogna NUMBER 2\Final excel sheets\Final PDF\" & strFile
'export to PDF in current folder
wkbSource.Sheets(Array("LowFlow GW Front", "LowFlow GW Back")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
strPathFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
Application.CutCopyMode = False 'If you ever need to copy a large amount of info, this will hide any warnings
ActiveWindow.View = xlPageBreakPreview
End With
wkbSource.Close savechanges:=False
strExtension = Dir
Loop
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
This code
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
it should be at the end of the routine and not in the middle of the loop.
I have a code that will export each individual tab as PDF in the same folder where the Excel file is located, it is working as intended on Windows, but failing on mac under the error "Application-defined or object-defined error", I've been researching on VBA use on Mac , but it seems that you need to save it in a completely different folder location that you need previous access to, any solution on this? It can work either on the same folder or in a folder that the user can select from an open dialog window. Below the code:
Option Explicit
Sub WorksheetLoop()
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
Dim WS_Count As Integer
Dim I As Integer
Dim fName As String
' Set WS_Count equal to the number of worksheets in the active workbook.
Set wbA = ActiveWorkbook
WS_Count = wbA.Worksheets.Count
strPath = wbA.Path
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
' Begin the loop.
For Each wsA In wbA.Worksheets
wsA.Activate
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = ActiveSheet.Range("D5").Value & ".pdf"
myFile = strPath & strFile
Debug.Print myFile
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
End If
Next wsA
MsgBox "Your PDF files have been created: "
Worksheets("Summary").Activate
End Sub
This sounds like a problem with "sandboxing" on the Mac. Starting with Office 2016, Apple made Microsoft limit the folders that Excel VBA could save files to.
I'm not exactly sure how you want to adjust your code to make it work, but Ron de Bruin has a great website about Excel VBA, and a particularly helpful section about doing it on the Mac. This particular page talks about the sandboxing issue, and explains which specific folders you should be able to save files to without any problems.
https://www.rondebruin.nl/mac/mac034.htm
I have a main Excel file that contains info for a project.
There will always also be another excel file named "Job export" in the same folder as my main file containing drawings - each drawing on separate sheet. Drawings will start from sheet 2 and end at sheet n-1 (currently the code will also print sheet 1 and sheet n).
I have found and modified VBA code that will print these drawings from each sheet into separate PDF files with the name in Cell C5 in each sheet.
But this means I have to open the excel file with drawings and copy the code to that workbook just to print the PDFs. I would like to add this code to my main Excel so that it opens the "Job export" excel in background and print drawings into separate PDFs.
Further step would be to save these PDFs to folders according to the client's name in Cell B7 and part number in B11 and onwards (in this case the saved PDF would also be named after the part number).
Is this possible with VBA?
Edit:
I'm stuck with chaning the save location of printed PDFs. I tried to just hard-code in the folder "C:\suvaline" but it won't save them there. As I wrote previously, the save folder should be: C:\suvaline\"Clients name"\"Part number" but it won't even work with the hard-coded one so I haven't even tried to get the clients name from Excel. Is there something I'm missing?
Sub ExportToPDFFromClosed()
Dim ws As Worksheet
Dim wbA As Workbook
Dim strPath
Dim strFile
Dim wb2 As Workbook
i = 11
j = 2
sPath = "C:\suvaline"
Application.ScreenUpdating = False
Set wbA = ActiveWorkbook
strPath = wbA.path
strPath = strPath & "\"
Set wbA = Workbooks.Open(strPath & "Job export pic3")
Set wb2 = ThisWorkbook
For Each ws In Worksheets
ws.Select
nm = wb2.Sheets("Prep+BOM").Cells(i, j).Value _
strFile = nm & ".pdf"
strPathFile = "C:\suvaline" & strFile
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=strPathFile & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 1
Next ws
wbA.Close
End Sub
This is the final code that works for me. Definitely not the most elegant:
Sub ExportToPDFFromClosed()
Dim ws As Worksheet
Dim wbA As Workbook
Dim strPath
Dim strFile
Dim wb2 As Workbook
Dim strPath2
Dim saveDest
i = 11
j = 2
Application.ScreenUpdating = False
Set wbA = ActiveWorkbook
strPath = wbA.path
strPath = strPath & "\"
Set wbA = Workbooks.Open(strPath & "Job export pic3")
Set wb2 = ThisWorkbook
strPath2 = wb2.Sheets("Prep+BOM").Range("B7")
saveDest = "C:\suvaline\" & strPath2 & "\"
For Each ws In Worksheets
ws.Select
nm = wb2.Sheets("Prep+BOM").Cells(i, j).Value _
strFile = nm & ".pdf"
strPathFile = saveDest & nm & "\" & strFile
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
filename:=strPathFile & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
i = i + 1
Next ws
wbA.Close
End Sub
I have a macro that I can use in many workbooks to export certain tabs by name to a PDF, which works. The problem is the named tabs which I need to export are not always in the same order/my desired order. My code below shows the names of the tabs which I am exporting to PDF, but excel defaults the export order of named tabs to the order in which they appear(from left to right). I was wondering if any of you know how I could define the order which these sheets appear in the PDF no matter what order they appear in my workbook? I am trying to avoid a macro that would export my sheets to a separate workbook temporarily to do this.
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
wbA.Activate
wbA.Sheets(Array(wbA.Sheets(2).Name, wbA.Sheets(3).Name)).Select
**------------------------------ THis is where I imagine the code would go**
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, Filename:=myFile, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False,
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Similar to what #fabio.avigo mentioned, modify the routine you posted like this:
Sub PDFActiveSheet(ByRef wsA As Worksheet)
...
'--- comment out this line
'Dim wsA As Worksheet
'--- and this one
'Set wsA = ActiveSheet
...
End Sub
Then create another sub to call it with your worksheets in any order you want, like this:
Public Sub PDFMySheets()
PDFActiveSheet ThisWorkbook.Sheets("Sheet3")
PDFActiveSheet ThisWorkbook.Sheets("Sheet2")
PDFActiveSheet ThisWorkbook.Sheets("Sheet1")
End Sub
The problem with exporting selected worksheets to a PDF is that Excel will save them in a single file, but only in the order they appear in the workbook. This means we'll have to re-order the worksheets to the desired order. The code below uses the PDFActiveSheet routine as posted in the OP, but adds logic to re-order the worksheets PLUS logic to restore the original order when we're done with the export.
Option Explicit
Public Sub SaveThem()
SaveSheetsToPDF "Sheet3", "Sheet1", "Sheet2"
End Sub
Private Sub SaveSheetsToPDF(ParamArray args())
'--- inputs to this sub are the Worksheet names to save to a single
' PDF file, in the order given. Excel will save multiple
' worksheets to a single PDF, but only in the order they exist
' in the workbook. So we'll have to re-order them.
Dim i As Long
Dim ws As Worksheet
Dim thisWB As Workbook
Set thisWB = ThisWorkbook
'--- initial error checking
If UBound(args, 1) = -1 Then
MsgBox "SaveSheetsToPDF called with no arguments!", _
vbCritical + vbOKOnly
Exit Sub
Else
'--- make sure the sheets exist before proceeding
For i = LBound(args, 1) To UBound(args, 1)
On Error Resume Next
Set ws = thisWB.Sheets(args(i))
If ws Is Nothing Then
MsgBox "SaveSheetsToPDF called with an invalid sheet name!", _
vbCritical + vbOKOnly
Exit Sub
End If
On Error GoTo 0
Next i
End If
'--- save the existing worksheet order
Dim numberOfWorksheetsInBook As Long
numberOfWorksheetsInBook = thisWB.Sheets.Count
Dim sheetsInOrder() As String
ReDim sheetsInOrder(1 To numberOfWorksheetsInBook)
For i = 1 To numberOfWorksheetsInBook
sheetsInOrder(i) = thisWB.Sheets(i).name
Debug.Print i & " = " & sheetsInOrder(i)
Next i
'--- move the given worksheets in the requested order after all the
' other worksheets
With thisWB
For i = LBound(args, 1) To UBound(args, 1)
.Sheets(args(i)).Move After:=.Sheets(numberOfWorksheetsInBook)
Next i
End With
'--- now save those worksheets to a PDF file
thisWB.Sheets(args).Select
PDFActiveSheet
'--- restore the original order to the sheets
Dim sheetName As Variant
With thisWB
For Each sheetName In sheetsInOrder
.Sheets(sheetName).Move Before:=.Sheets(1)
Next sheetName
End With
End Sub
Sub PDFActiveSheet()
'www.contextures.com
'for Excel 2010 and later
Dim wsA As Worksheet
Dim wbA As Workbook
Dim strTime As String
Dim strName As String
Dim strPath As String
Dim strFile As String
Dim strPathFile As String
Dim myFile As Variant
On Error GoTo errHandler
Set wbA = ActiveWorkbook
Set wsA = ActiveSheet
strTime = Format(Now(), "yyyymmdd\_hhmm")
'get active workbook folder, if saved
strPath = wbA.path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
'replace spaces and periods in sheet name
strName = Replace(wsA.name, " ", "")
strName = Replace(strName, ".", "_")
'create default name for savng file
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
'use can enter name and
' select folder for file
myFile = Application.GetSaveAsFilename(InitialFileName:=strPathFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
'export to PDF if a folder was selected
If myFile <> "False" Then
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
'confirmation message with file info
MsgBox "PDF file has been created: " _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
I have a Data validation list which contains Names of Employees each month i manually go through each one and press a print button with the following macro.
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = Cells.Range("B1") & " Period " & Cells.Range("J1")
strFile = ThisWorkbook.Path & "\" & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strFile, _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Folder and FileName to save")
If myFile <> "False" Then
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False, _
From:=1, _
To:=2
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
This Prints the sheet out to the pathway where the workbook is saved.
My Data Validation List is in Cell 'B1' Is there a way i can use VBA to loop through the list and print these for me? I Have not been able to really get going doing a draft as using a data validation list in vba is completely new to me.
Sub Loop_Through_List()
Dim Name As Variant
'Dim List As ListBox?
For Each Name in List
Call PDFActiveSheet
Next
You can use something like this:
Sub Loop_Through_List()
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Set DV_Cell = Range("B1")
Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
For Each cell In rgDV.Cells
DV_Cell.Value = cell.Value
Call PDFActiveSheet
Next
End Sub
Edit: revised code based on comments below:
Sub Loop_Through_List()
Dim cell As Excel.Range
Dim rgDV As Excel.Range
Dim DV_Cell As Excel.Range
Set DV_Cell = Range("B1")
Set rgDV = Application.Range(Mid$(DV_Cell.Validation.Formula1, 2))
For Each cell In rgDV.Cells
DV_Cell.Value = cell.Value
Call PDFActiveSheet
Next
End Sub
Sub PDFActiveSheet()
Dim ws As Worksheet
Dim myFile As Variant
Dim strFile As String
Dim sFolder As String
On Error GoTo errHandler
Set ws = ActiveSheet
'enter name and select folder for file
' start in current workbook folder
strFile = ws.Range("B1").Value & " Period " & ws.Range("J1").Value
sFolder = GetFolder()
If sFolder = "" Then
MsgBox "No folder selected. Code will terminate."
Exit Sub
End If
myFile = sFolder & "\" & strFile
ws.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False, _
From:=1, _
To:=2
exitHandler:
Exit Sub
errHandler:
MsgBox "Could not create PDF file"
Resume exitHandler
End Sub
Function GetFolder() As String
Dim dlg As FileDialog
Set dlg = Application.FileDialog(msoFileDialogFolderPicker)
dlg.InitialFileName = ThisWorkbook.Path & "\"
dlg.Title = "Select folder to save PDFs"
If dlg.Show = -1 Then
GetFolder = dlg.SelectedItems(1)
End If
End Function