Below you can find my code that is working for a certain area. But I want to add a new element in the code but I can't find it how I can do it. The first area is A1:E42, but now I have one worksheet where I have 3 area. A1:E42, H1:K42 and O1:R42). How do I need to rewrite my code that the first area comes on the first pdf page, the second area on the second page et cetera.
Sub SavePDF()
Dim ws As Worksheet
Set ws = ThisWorkbook.ActiveSheet
With ws.PageSetup
.Orientation = xlLandscape
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
.PrintArea = "A1:E42"
End With
Set ws = Nothing
Sheets("Offerte_M").ExportAsFixedFormat x1TypePDF, Filename:= _
"C:\Intel\" & ActiveSheet.Range("F21").Value & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
MsgBox "Offerte has been saved as PDF. Press send now."
I thought maybe this was the correct way, but that doesn't work also.
Sub CommandButton1_Click()
Application.ScreenUpdating = False
Offerte_M.PageSetup.PrintArea = "A1:E42"
Offerte_M.PageSetup.PrintArea = "H1:K42"
Offerte_M.PageSetup.PrintArea = "O1:R42"
Worksheets(Array("Offerte_M")).Select.ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:="C:\Intel\" & ActiveSheet.Range("F21").Value & ".pdf", _
OpenAfterPublish:=True
Offerte_M.PageSetup.PrintArea = ""
Offerte_M.PageSetup.PrintArea = ""
Offerte_M.PageSetup.PrintArea = ""
Offerte_M.Select
Application.ScreenUpdating = True
End Sub
this code used to run perfectly now is having time error 53, file not found. Not sure what is wrong
Sub printxxx()
' Print_quote XXX Macro
ActiveSheet.PageSetup.Orientation = xlLandscape
Worksheets("Quote").PageSetup.PrintArea = "$H$6:$Z$133"
strFile = ThisWorkbook.Path & "\" & strFile
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ThisWorkbook.Path & "\" & CreateObject("Scripting.FileSystemObject").GetFile(ThisWorkbook.FullName).ParentFolder.Name & " XXXQuote ", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
ActiveSheet.PageSetup.Orientation = xlPortrait
End Sub
I need to loop through named worksheets creating a pdf from each sheet and saving it to a folder.
Have so far created the below and its getting stuck saying wrong number of arguments.
It gets stuck at '3 Pages If Range("B16") = "3 page Statement" Then Range - it then says
"Wrong number of arguments or invalid property assignment"
Using Win 7 and Excel 2010
Sub CreatePDFs_Click()
' CreatePDF_Statements
'
' Create a PDF from the current sheet and save to folder
Dim DestFolder As String, PDFFile As String
Dim OpenPDFAfterCreating As Boolean, AlwaysOverwritePDF As Boolean, DisplayEmail As Boolean
Dim OverwritePDF As VbMsgBoxResult
Dim ws As Worksheet
Dim sheet_name As Range
'Loop
For Each sheet_name In Sheets("Info").Range("A:A")
If sheet_name.Value = "" Then
Exit For
Else
Sheets(sheet_name.Value).Select
ws.Activate
OpenPDFAfterCreating = False 'Change this if you want to open the PDF after creating it : TRUE or FALSE
AlwaysOverwritePDF = False 'Change this if you always want to overwrite a PDF that already exists :TRUE or FALSE
DestFolder = Sheets("Dashboard").Range("M4")
'Customer Name stored in B8
CustomerName = Left(ActiveSheet.Range("B8").Value, InStr(1, ActiveSheet.Range("B8").Value, " ") + 50)
'Create new PDF file name including path and file extension
PDFFile = DestFolder & Application.PathSeparator & CustomerName & ".pdf"
'If the PDF already exists
If Len(Dir(PDFFile)) > 0 Then
If AlwaysOverwritePDF = False Then
OverwritePDF = MsgBox(PDFFile & " already exists." & vbCrLf & vbCrLf & "Do you want to overwrite it?", vbYesNo + vbQuestion, "File Exists")
On Error Resume Next
'If you want to overwrite the file then delete the current one
If OverwritePDF = vbYes Then
Kill PDFFile
Else
MsgBox "OK then, if you don't overwrite the existing PDF, I can't continue." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Exiting Macro"
Exit Sub
End If
Else
On Error Resume Next
Kill PDFFile
End If
If Err.Number <> 0 Then
MsgBox "Unable to delete existing file. Please make sure the file is not open or write protected." _
& vbCrLf & vbCrLf & "Press OK to exit this macro.", vbCritical, "Unable to Delete File"
Exit Sub
End If
End If
'Create the PDF
'0 Page
If Range("B16") = "0 page Statement" Then
Range("B2:I50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'1 Page
If Range("B16") = "1 page Statement" Then
Range("B2:I50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'2 Pages
If Range("B16") = "2 page Statement" Then
Range("B2:I50,K2:R50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'3 Pages
If Range("B16") = "3 page Statement" Then
Range("B2:I50,K2:R50,T2:AA50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'4 Pages
If Range("B16") = "4 page Statement" Then
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
'5 Pages
If Range("B16") = "5 page Statement" Then
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50,AL2:AS50").Select
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:=PDFFile, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=OpenPDFAfterCreating
End If
Cancel = True
End If
Sheets("Dashboard").Select
Range("A1").Select
End Sub
Distilling the error message...
"Wrong number of arguments or invalid property assignment"
... the problem is that you are trying to pass 3+ arguments to Range, which can at most take 2. You want to combine each different area within a single range reference.
Change
Range("B2:I50", "K2:R50")
...
Range("B2:I50", "K2:R50", "T2:AA50")
...
Range("B2:I50", "K2:R50", "T2:AA50", "AC2:AJ50")
...
Range("B2:I50", "K2:R50", "T2:AA50", "AC2:AJ50", "AL2:AS50")
to
Range("B2:I50,K2:R50")
...
Range("B2:I50,K2:R50,T2:AA50")
...
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50")
...
Range("B2:I50,K2:R50,T2:AA50,AC2:AJ50,AL2:AS50")
something is wrong with the macro, it keeps saving the way i want it to, but names the file "true" or "false". Note: the cell value itself is "=today()"
Sub Macro1()
'
' Macro1 Macro
ActiveWorkbook.SaveAs Filename = Range("C6").Value
FileFormat = xlOpenXMLWorkbookMacroEnabled
CreateBackup = False
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF
Filename = Range("c6").Value
FileFormat = pdf
Quality = xlQualityStandard
IncludeDocProperties = True
IgnorePrintAreas = False
OpenAfterPublish = False
End Sub
Try Filename:=Range("c6").Text to get the date as it appears in the cell.
The operator syntax is := between argument name and argument value.
Sub Macro1()
ActiveWorkbook.SaveAs _
Filename:=Range("C6").Text, _
FileFormat:=xlOpenXMLWorkbookMacroEnabled, _
CreateBackup:=False
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=Range("c6").Text, _
FileFormat:=xlpdf, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
So this is my code that´s is supposed to loop through the pivot's SUPPLIER FILTER based on a list located in the same worksheet. After every loop it has to upload the file to the intranet in a .pdf format.
Sub Upload()
Dim pt As PivotTable
Dim pi As PivotItem
Dim pf As PivotField
Dim lLoop As Long
Set pt = Sheets("To Supplier").PivotTables("PivotTable1")
Set pf = pt.PivotFields("[Query].[SUPPLIER].[SUPPLIER]")
Sheets("To Supplier").Select
For Each pi In pf.PivotItems
On Error Resume Next
pf.CurrentPage = pi.Value
On Error GoTo 0
If pf.CurrentPage = pi.Value Then
If lLoop = 0 Then
With Sheets("To Supplier").PageSetup
.CenterFooter = pi.Value
.LeftHeader = pt.Name
.LeftFooter = Now
End With
End If
Range("L2").Select
ActiveCell.FormulaR1C1 = _
"=INDEX(RC[-6]:R[59]C[-5],MATCH(R[1]C[-10],RC[-6]:R[59]C[-6],0),2)"
Sheets("To Supplier").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"http://collaborationx.com/portalone/sourcing/Supplier%20documents/" & Cell("L2").Value _
& "/Evaluations/" & Cell("L2").Value & "%20Credits.pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
lLoop = lLoop + 1
End If
Next pi
End Sub
However, It keeps throwing me off... now the prob is that it says the function is not defined, before the problem was with the references...
Cell("L2") is not defined. You probably wanted Range("L2") but since you selected that range before you could use ActiveCell. Example, HTH.
Option Explicit
Sub test()
Range("L2").Select
ActiveCell.FormulaR1C1 = "=INDEX(RC[-6]:R[59]C[-5],MATCH(R[1]C[-10],RC[-6]:R[59]C[-6],0),2)"
Dim exportFileName As String
exportFileName = "http://collaborationx.com/portalone/sourcing/Supplier%20documents/{0}/Evaluations/{0}%20Credits.pdf"
exportFileName = Replace(exportFileName, "{0}", ActiveCell.Value)
Sheets("To Supplier").ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=exportFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End Sub