I'm printing some PDF from my Excel thanks to a little program, which was working and is not anymore and I can't figure out why. it's telling me
error '5' argument or procedure call incorrect.
I think it's really a stupid mistake but I have the nose in it and can't find it.
N.B. The filename part is not the issue, I have the same result when I change it for a basic thing like "bob"
Sub impression_multiple_pdf()
Dim chaine As String
Dim WS As Worksheet
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Tampon" And WS.Name <> "data" And WS.Name <> "Tableau de
Bord" Then
WS.ExportAsFixedFormat Type:=xlTypePDF,
Filename:=ThisWorkbook.Path & "\Fiches Projet\Fiche Projet " &
clear_name(WS.Range("C3")), Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False,
OpenAfterPublish:=False
End If
Next
ThisWorkbook.Activate
MsgBox "Fiches projet enregistrées dans mes documents"
End Sub
Clear name function :
Function clear_name(txt)
Dim C
C = Array("<", ">", "?", "[", "]", ":", "*", "\", "/", "|", ".", "#", "€",
",", "§", "#")
'txt = Range("A2")
For n = 0 To UBound(C)
txt = Left(Trim(txt), 128)
txt = Replace(txt, C(n), "")
Next
clear_name = txt
End Function
Make sure clear_name(WS.Range("C3")) is not empty.
Also make sure ThisWorkbook.Path returns a value that means your workbook needs to be saved at least once. And make sure your path exists \Fiches Projet\Fiche Projet otherwise it fails.
Sub impression_multiple_pdf()
Dim chaine As String
Dim WS As Worksheet
Dim Filename As String
For Each WS In ThisWorkbook.Worksheets
If WS.Name <> "Tampon" And WS.Name <> "data" And WS.Name <> "Tableau de Bord" Then
Filename = clear_name(WS.Range("C3"))
If Filename <> "" Then
WS.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & "\Fiches Projet\Fiche Projet " & Filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Else
MsgBox "Filename in '" & WS.Name & "' was empty"
End If
End If
Next WS
ThisWorkbook.Activate
MsgBox "Fiches projet enregistrées dans mes documents"
End Sub
If this doesn't help use
Debug.Print ThisWorkbook.Path & "\Fiches Projet\Fiche Projet " & Filename
right after the line Filename = clear_name(WS.Range("C3")) and tell the result that is printed in the Immediate Window.
Try editing this part
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\Fiches Projet\Fiche Projet " & clear_name(ws.Range("C3")), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
Related
I have never really worked with VBA and I am getting stuck on a simple problem.
Essentially I have a workbook with multiple worksheets. I Have a Macro which prints all worksheets to pdf. I want to change the macro to only print specific worksheets
Code sofar:
Sub Print_All_pages()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Select
nm = ws.Name
Dim Filepath As String
Filepath = Range("Destination").Value & "\Übersicht Bonus - " & Range("Month").Value & " " & Range("Year").Value & " - " & nm & ".pdf"
Range("A1:N35").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Filepath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
Next ws
Worksheets("Main Sheet").Activate
End Sub
I hav tried the following which doesn't work
For Each ws in Worksheets
If ws.Name = "Textbausteine Mail" Or ws.Name = "Overzichten verzenden" Or ws.Name = "Übersicht_Januar" Then
'Do nothing
Else
nm = ws.Name
Dim Filepath As String
Filepath = Range("Destination").Value & "\Übersicht Bonus - " & Range("Month").Value & " " & Range("Year").Value & " - " & ws.Name & ".pdf"
Range("A1:N35").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Filepath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
Next ws
Worksheets("Main Sheet").Activate
This however throws me the error compilation error Next without for
Here is the workbook setup:
Any help is greatly appreciated
Export Range to PDF
A Quick Fix
Option Explicit
Sub ExportToPDF()
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim FilePathLeft As String
With wb.Worksheets("Main Sheet")
FilePathLeft = .Range("Destination").Value & "\Übersicht Bonus - " _
& .Range("Month").Value & " " & .Range("Year").Value & " - "
End With
Dim ws As Worksheet
Dim FilePath As String
For Each ws In wb.Worksheets
Select Case ws.Name
' do NOT export:
Case "Textbausteine Mail", "Overzichten verzenden", "Übersicht_Januar"
' do export:
Case Else
FilePath = FilePathLeft & ws.Name & ".pdf"
ws.Range("A1:N35").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FilePath, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=False
End Select
Next ws
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 have combined some code from a couple of different examples to get this to work but my solution seems klunky in that I am creating 2 pdfs. One in a temp folder, and one in the current folder. The one in the temp folder is the one getting attached to the email. I would like to just save a single pdf in the current folder and attach that pdf to the email.
This is the code that exports both pdf's:
Title = ActiveSheet.Range("B11").Value & " Submittal"
' Define PDF filename in TEMP folder
PdfFile = ActiveWorkbook.Name
i = InStrRev(PdfFile, ".xl", , vbTextCompare)
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Title
For Each char In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
For some reason, if I add ThisWorkbook.Path & "\" to the Filename of the first exported file like this: Filename:=ThisWorkbook.Path & "\" & PdfFile, so it saves in the current folder instead of the temp folder, I get a runtime error and it doesn't save even though this is the same code that exports the second pdf file successfully to the current folder.
Here is the full working code but I want to eliminate the temp pdf if possible:
Sub RightArrow2_Click()
Dim IsCreated As Boolean
Dim PdfFile As String, Title As String
Dim OutlApp As Object
Dim i As Long
Dim char As Variant
Title = ActiveSheet.Range("B11").Value & " Submittal"
' Define PDF filename in TEMP folder
PdfFile = ActiveWorkbook.Name
i = InStrRev(PdfFile, ".xl", , vbTextCompare)
If i > 1 Then PdfFile = Left(PdfFile, i - 1)
PdfFile = Title
For Each char In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) & "\" & PdfFile, 251) & ".pdf"
'Debug.Print PdfFile
' Export activesheet as PDF to the temporary folder
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PdfFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\" & ActiveSheet.Range("B11").Value & " Submittal", Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End With
' Use already open Outlook if possible
On Error Resume Next
Set OutlApp = GetObject(, "Outlook.Application")
If Err Then
Set OutlApp = CreateObject("Outlook.Application")
IsCreated = True
End If
On Error GoTo 0
' Prepare e-mail with PDF attachment
With OutlApp.CreateItem(0)
' Prepare e-mail
.Subject = Title
.To = ActiveSheet.Range("H12").Value
.CC = ""
.Body = "Please see the attached submittal for " & ActiveSheet.Range("B11").Value & "." & vbLf & vbLf _
& "Thank you," & vbLf & vbLf _
& vbLf
.Attachments.Add PdfFile
' Display email
On Error Resume Next
.Display ' or use .Send
' Return focus to Excel's window
Application.Visible = True
If Err Then
MsgBox "E-mail was not sent", vbExclamation
Else
MsgBox "E-mail successfully sent", vbInformation
End If
On Error GoTo 0
End With
' Delete the temporary PDF file
If Len(Dir(PdfFile)) Then Kill PdfFile
' Try to quit Outlook if it was not previously open
If IsCreated Then OutlApp.Quit
' Release the memory of object variable
' Note: sometimes Outlook object can't be released from the memory
Set OutlApp = Nothing
End Sub
In your description, in the line of code
Filename:=ThisWorkbook.Path & "\" & PdfFile
the PdfFile variable contains the path to the temp folder which is why you get the error.
First, remove this line:
PdfFile = Left(CreateObject("Scripting.FileSystemObject").GetSpecialFolder(2) _
& "\" & PdfFile, 251) & ".pdf"
And then this line:
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path _
& "\" & .Range("B11").Value & " Submittal", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
I am not sure how you're creating your filename for your PDF but it should be something like this:
If you retrieve it from a Range:
With Thisworkbook
PdfFile = .Path & Application.PathSeparator & _
.Sheets("SheetName").Range("B11") & "Submittal.pdf"
End With
If you need to do manipulations on the text like what you did:
Title = ActiveSheet.Range("B11").Value & " Submittal"
PdfFile = Title
For Each c In Split("? "" / \ < > * | :")
PdfFile = Replace(PdfFile, char, "_")
Next
PdfFile = Thisworkbook.Path & Application.PathSeparator & PdfFile & ".pdf"
Once you've created a valid filename, the below code should work:
With ActiveSheet
.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=PdfFile, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
I have a code that prints a selected area in a worksheet to PDF and allows user to select folder and input file name.
There are two things I want to do though:
Is there a way that the PDF file can create a folder on the users desktop and save the file with a file name based on specific cells in the sheet?
If multiple copies of the same sheet are saved/printed to PDF can each copy have a number eg. 2, 3 in the filename based on the copy number?**
Here is the code I have so far:
Sub PrintRentalForm()
Dim filename As String
Worksheets("Rental").Activate
filename = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and Filename to save")
If filename <> "False" Then
With ActiveWorkbook
.Worksheets("Rental").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End With
End If
filename = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and Filename to save")
If filename <> "False" Then
With ActiveWorkbook
.Worksheets("RentalCalcs").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End With
End If
End Sub`
UPDATE:
I have changed the code and references and it now works. I have linked the code to a commandbutton on the Rental Sheet -
Private Sub CommandButton1_Click()
Dim filenamerental As String
Dim filenamerentalcalcs As String
Dim x As Integer
x = Range("C12").Value
Range("C12").Value = x + 1
Worksheets("Rental").Activate
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
filenamerental = Path & "\" & Sheets("Rental").Range("O1")
'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("Rental").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filenamerental, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Worksheets("RentalCalcs").Activate
Path = CreateObject("WScript.Shell").specialfolders("Desktop")
filenamerentalcalcs = Path & "\" & Sheets("RentalCalcs").Range("O1")
'ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
Worksheets("RentalCalcs").Range("A1:N24").Select
Selection.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=filenamerentalcalcs, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
Worksheets("Rental").Activate
Range("D4:E4").Select
End Sub
Hopefully this is self explanatory enough. Use the comments in the code to help understand what is happening. Pass a single cell to this function. The value of that cell will be the base file name. If the cell contains "AwesomeData" then we will try and create a file in the current users desktop called AwesomeData.pdf. If that already exists then try AwesomeData2.pdf and so on. In your code you could just replace the lines filename = Application..... with filename = GetFileName(Range("A1"))
Function GetFileName(rngNamedCell As Range) As String
Dim strSaveDirectory As String: strSaveDirectory = ""
Dim strFileName As String: strFileName = ""
Dim strTestPath As String: strTestPath = ""
Dim strFileBaseName As String: strFileBaseName = ""
Dim strFilePath As String: strFilePath = ""
Dim intFileCounterIndex As Integer: intFileCounterIndex = 1
' Get the users desktop directory.
strSaveDirectory = Environ("USERPROFILE") & "\Desktop\"
Debug.Print "Saving to: " & strSaveDirectory
' Base file name
strFileBaseName = Trim(rngNamedCell.Value)
Debug.Print "File Name will contain: " & strFileBaseName
' Loop until we find a free file number
Do
If intFileCounterIndex > 1 Then
' Build test path base on current counter exists.
strTestPath = strSaveDirectory & strFileBaseName & Trim(Str(intFileCounterIndex)) & ".pdf"
Else
' Build test path base just on base name to see if it exists.
strTestPath = strSaveDirectory & strFileBaseName & ".pdf"
End If
If (Dir(strTestPath) = "") Then
' This file path does not currently exist. Use that.
strFileName = strTestPath
Else
' Increase the counter as we have not found a free file yet.
intFileCounterIndex = intFileCounterIndex + 1
End If
Loop Until strFileName <> ""
' Found useable filename
Debug.Print "Free file name: " & strFileName
GetFileName = strFileName
End Function
The debug lines will help you figure out what is happening if you need to step through the code. Remove them as you see fit. I went a little crazy with the variables but it was to make this as clear as possible.
In Action
My cell O1 contained the string "FileName" without the quotes. Used this sub to call my function and it saved a file.
Sub Testing()
Dim filename As String: filename = GetFileName(Range("o1"))
ActiveWorkbook.Worksheets("Sheet1").Range("A1:N24").ExportAsFixedFormat Type:=xlTypePDF, _
filename:=filename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
Where is your code located in reference to everything else? Perhaps you need to make a module if you have not already and move your existing code into there.