I already have a code that do the exporting to PDF, it exports the selected sheets but I want to make the exported selection in the sheets bigger in the PDF file, to help the printing phase later.
Here's the code that do the exporting:
Sub PDFActiveSheet()
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")
strPath = wbA.Path
If strPath = "" Then
strPath = Application.DefaultFilePath
End If
strPath = strPath & "\"
strName = Replace(wsA.Name, " ", "")
strName = Replace(strName, ".", "_")
strFile = strName & "_" & strTime & ".pdf"
strPathFile = strPath & strFile
myFile = Application.GetSaveAsFilename _
(InitialFileName:=strPathFile, _
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:=False
MsgBox "Les QrCodes ont été exporter dans le fichier PDF" _
& vbCrLf _
& myFile
End If
exitHandler:
Exit Sub
errHandler:
MsgBox "Erreur lors de l'exportation"
Resume exitHandler
End Sub
If you simply want to zoom in by a fix %, use the following command before the export line
wsA.PageSetup.Zoom = 150
Related
I wrote below code, this code upload all document from share drive into excel based on their naming convention.
However it's applicable for Pdf file only. can you please help me that how can i upload other ext file as well like outlook/word/excel?
Dim folderPath As String, fileName As String
Dim destCell As Range
With Worksheets("ABC")
folderPath = .Range("F7").Value
Set destCell = .Range("G12")
End With
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Application.ScreenUpdating = False
fileName = Dir(folderPath & "ABC*.pdf")
Do While fileName <> vbNullString
destCell.Worksheet.OLEObjects.Add _
fileName:=folderPath & fileName, _
Link:=False, _
DisplayAsIcon:=True, _
IconFilename:="C:\windows\Installer\{AC76BA86-1033-F400-7760-000000000005}\_PDFFile.ico", _
IconIndex:=0, _
IconLabel:=fileName, _
Left:=destCell.Left, _
Top:=destCell.Top, _
Width:=150, _
Height:=5
Set destCell = destCell.Offset(, 1)
fileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Document Uploaded Successfully..!!"
Something Like This?
Dim folderPath As String, fileName As String
Dim destCell As Range
With Worksheets("ABC")
folderPath = .Range("F7").Value
Set destCell = .Range("G12")
End With
If Right(folderPath, 1) <> "\" Then folderPath = folderPath & "\"
Application.ScreenUpdating = False
fileName = Dir(folderPath & "ABC*.*")
Do While fileName <> vbNullString
destCell.Worksheet.OLEObjects.Add _
fileName:=folderPath & fileName, _
Link:=False, _
DisplayAsIcon:=True, _
IconFilename:="C:\windows\Installer\{AC76BA86-1033-F400-7760-000000000005}\_PDFFile.ico", _
IconIndex:=0, _
IconLabel:=fileName, _
Left:=destCell.Left, _
Top:=destCell.Top, _
Width:=150, _
Height:=5
Set destCell = destCell.Offset(, 1)
fileName = Dir
Loop
Application.ScreenUpdating = True
MsgBox "Document Uploaded Successfully..!!"
I am trying to convert an excel sheet to pdf than save it to a folder on my desktop, however, I keep getting a run time error of 1004 - application-defined or object defined error. I have placed the code below. Can anyone please assist?
Private Sub pdfAlternate()
Dim strPathLocation As String
Dim strFilename As String
Dim strPathFile As String
Dim fileSaveName As String
Dim fileSavePath As String
Dim pdfOpenAfterPublish As Boolean
strPathLocation = Worksheets("Form").Range("C11").Value
strFilename = Worksheets("Form").Range("L11").Value
fileSaveName = strPathLocation & "_" & strFilename
fileSavePath = "C:\Users\fou55227\Desktop\BMW" & "\" & fileSaveName & "_" & Format(Date, "MM.DD.YYYY") & ".pdf"
ActiveWorkbook.Sheets("Form").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fileSavePath _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
Debug.Print fileSaveName
Debug.Print fileSavePath
End Sub
I'm trying to create separate PDFs for each sheet in a selection of sheets, with a name determined by the sheet name and the contents of one cell.
The code is as follows:
Sub SaveWorksheetsAsPDFs()
Dim sFile As String
Dim sPath As String
Dim sh As Object
Dim InvDate As String
With ActiveWorkbook
sPath = .Path & "\"
For Each sh In ActiveWindow.SelectedSheets
InvDate = Format(Range("G9"), "dd-mm-yy")
sFile = sh.Name & " - Invoice - " & InvDate & ".pdf"
sh.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sPath & sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next sh
End With
End Sub
Separate PDFs are created and named correctly, however, the PDF contains all the selected sheets instead of one.
With my experience, i've seen that the ExportAsFixedFormat always exports all selected sheets.
You can come around this by saying sh.Select after your For Each, and then it should works as you describe in the OP.
Edited code:
Sub SaveWorksheetsAsPDFs()
Dim sFile As String
Dim sPath As String
Dim sh As Object
Dim InvDate As String
With ActiveWorkbook
sPath = .Path & "\"
For Each sh In ActiveWindow.SelectedSheets
sh.Select '<----- New LINE
InvDate = Format(Range("G9"), "dd-mm-yy")
sFile = sh.Name & " - Invoice - " & InvDate & ".pdf"
sh.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=sPath & sFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
Next sh
End With
End Sub
Hope this helps you achive your goal. :)
I have cobbled together a VBA script that loops through a list of data, changing the value of a single cell on a summary page. That cell drives a number of formulas. After each iteration, the cell range of interest is saved off as a PDF.
I am looking to avoid having to manually hit enter every time the 'save as' dialog box is generated on each loop. Once I deploy this script, I could be looking at 1k+ iterations.
Sub AlterID()
Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
Set ws = Worksheets("Summary Data")
For Each c In Worksheets("Data").Range("A2:A11").Cells
Worksheets("Summary Data").Range("B1").Value = c.Value
strFile = ws.Range("D3").Value
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.Range("D3:H9").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=myFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
Next
End Sub
Sub AlterID()
Dim ws As Worksheet, c As Range
Dim strFile As String
Set ws = Worksheets("Summary Data")
For Each c In Worksheets("Data").Range("A2:A11").Cells
ws.Range("B1").Value = c.Value
strFile = ThisWorkbook.Path & "\" & ws.Range("D3").Value
ws.Range("D3:H9").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=strFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Next
End Sub
Have you tried turning off application alerts?
Application.DisplayAlerts = False 'before your code
Application.DisplayAlerts = True 'after your code
Edit 1
Here is a sub I use to save a file to a PDF
Sub SaveAsPDF()
Dim myValue As Variant
Dim mySheets As Variant
mySheets = Array("Report")
For Each sh In mySheets
Sheets(sh).PageSetup.Orientation = xlLandscape
Next
uid = InputBox("Enter your UID")
uid = StrConv(uid, vbProperCase)
Application.PrintCommunication = False
With Sheets("Report").PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
End With
Application.PrintCommunication = True
Dim fName As String
fName = "HMB SOX report for week ending " & ActiveSheet.Range("H4").Text
Call selectPage("Report")
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
"C:\Users\" & uid & "\Desktop\" & fName, :=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, Publish:=False
End With
End Sub
I'm working vba macro which works perfectly but I need save the documents as .pdf.
I´m searching for tips, but I don´t know how to find them. Last time I found this solution : vba mail merge save as pdf
but I don´t know apply it to my macro.
Here is my code:
Sub RunMerge()
Dim wd As Object
Dim wdocSource As Object
Dim strWorkbookName As String
On Error Resume Next
Set wd = GetObject(, "Word.Application")
If wd Is Nothing Then
Set wd = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wdocSource = wd.Documents.Open(ThisWorkbook.Path & "\" & "ArtSpecDatabase.docx")
strWorkbookName = ThisWorkbook.Path & "\" & ThisWorkbook.Name
wdocSource.MailMerge.MainDocumentType = wdFormLetters
wdocSource.MailMerge.OpenDataSource _
Name:=strWorkbookName, _
AddToRecentFiles:=False, _
Revert:=False, _
Connection:="Data Source=" & strWorkbookName & ";Mode=Read", _
SQLStatement:="SELECT * FROM `Sheet2$`"
With wdocSource.MailMerge
.Destination = wdSendToNewDocument
.SuppressBlankLines = True
With .DataSource
.FirstRecord = 1
.LastRecord = 1
End With
.Execute Pause:=False
End With
Dim PathToSave As String
PathToSave = ThisWorkbook.Path & "\" & "pdf" & "\" & Sheets("Sheet2").Range("B2").Value2 & ".docx"
If Dir(PathToSave, 0) <> vbNullString Then
wd.FileDialog(FileDialogType:=msoFileDialogSaveAs).Show
Else
wd.activedocument.SaveAs2 PathToSave, wdFormatDocumentDefault
End If
wd.Visible = True
wdocSource.Close savechanges:=False
wd.activedocument.Close savechanges:=False
Set wdocSource = Nothing
Set wd = Nothing
End Sub
To export a Word document as PDF, you need to use the ExportAsFixedFormat method. For example, you can replace your SaveAs2 call with this:
wd.ActiveDocument.ExportAsFixedFormat PathToSave, 17 'The constant for wdExportFormatPDF
Now, your call to FileDialog makes no sense, so I propose changing the entire Dir(...) If-sentence to this:
Dim PathToSave As String
PathToSave = ThisWorkbook.Path & "\" & "pdf" & "\" & Sheets("Sheet2").Range("B2").Value2 & ".pdf"
If Dir(PathToSave, 0) <> vbNullString Then
With wd.FileDialog(FileDialogType:=msoFileDialogSaveAs)
If .Show = True Then
PathToSave = .SelectedItems(1)
End If
End With
End If
wd.ActiveDocument.ExportAsFixedFormat PathToSave, 17 'The constant for wdExportFormatPDF
EDIT: Forgot to include ".pdf" extension.
Use the below code to export excel to pdf
Sub tst1()
Dim fFilename As String
fFilename = "C:\Documents and Settings\test.xlsx"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
fFilename & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
End Sub