Excel - Hiding last picture in row of invoice - vba

I have built an Invoice worksheet that has a top portion (A1:K19) that will remain static; this is the top portion of the invoice. Below Row 19 starts the individual item lines that will be populated with what items are ordered.
I have created a macro for the user that will automatically format the invoice into a 1 page PDF and autohide the unused line item rows; however I have pictures in each line item line.
When I run my macro it hides all the pictures expect the last one. How can I hide the last image box that just sticks out and doesn't hide with row. If I individually hide that row alone it hides, but with a group it does not.
Below is the current VBA script I have written.
Sub Save_Quote_As_PDF()
Application.ScreenUpdating = False
For i = 20 To 59
If ActiveSheet.Cells(i, 3) = "" Then
ActiveSheet.Cells(i, 3).EntireRow.Hidden = True
End If
Next i
Dim PdfFilename As Variant
PdfFilename = Application.GetSaveAsFilename( _
InitialFileName:=ActiveWorkbook.Path & "\" & ActiveSheet.Range("N2").Value, _
FileFilter:="PDF, *.pdf", _
Title:="Save As PDF")
If PdfFilename <> False Then
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.PrintArea = "$A$1:$K$78"
.PrintTitleRows = ActiveSheet.Rows(19).Address
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=PdfFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
For i = 20 To 59
If ActiveSheet.Cells(i, 3) = "" Then
ActiveSheet.Cells(i, 3).EntireRow.Hidden = False
End If
Next i
Application.ScreenUpdating = True
End Sub
Here is a screenshot of the pdf section that shows the pic object showing
Screenshot of Image Not Hiding in PDF results

I recreated your code above with my own sample data. The issue seems to be when the images don't have "move and size with cells" (in their properties).
If you have code elsewhere, that's inserting those images then you'll need to do this,
Sub Move_Size()
Dim i As Long
For i = 1 To ActiveSheet.Shapes.Count
On Error Resume Next
With ActiveSheet.Shapes.Item(i)
.Placement = xlMoveAndSize
.PrintObject = True
End With
Next i
On Error Goto 0
End Sub
Taken from here

Related

VBA Excel - Sub is Printing old data

I am encountering a problem when I am attempting to print an Excel worksheet. I have a sub that calls two other subs, see below:
Sub AutoGen_NOW()
Application.Calculation = xlCalculationAutomatic
autoGen_refresh
autoGen_invoiceStageGen
End Sub
The subs called are
1. autoGen_refresh
2. autoGen_invoiceStageGen
The first sub called refreshes a workbook connection, while the second sub prints a worksheet that references the connection. My problem is, even though the printing sub occurs after the refresh sub, the printing sub prints the worksheet as it appeared before the refresh, not with the new data. When i look at the worksheet manually, after the print, it contains the new data.
Any help on this is much appreciated. I have added the two subs below:
Sub autoGen_refresh()
Dim LastAnnual As WorkbookConnection
Dim LastMonthly As WorkbookConnection
Dim oledbCn As OLEDBConnection
Set LastAnnual = ThisWorkbook.Connections("Staging_AnnualLastEntry")
Set LastMonthly = ThisWorkbook.Connections("Staging_MonthlyLastEntry")
'Refresh Annual Connection if Annual is selected - Refresh Monthly Connection if Monthly is selected
If MonthForm.OptionButton16.Value = True Then
LastAnnual.Refresh
Else
LastMonthly.Refresh
MonthlyTemp
MonthlyHide
End If
End Sub
Sub autoGen_invoiceStageGen()
Dim FolderPath As String
Dim sourceSheet As Worksheet 'This is the Worksheet where the data connection is
Dim i As Long
'Dim template worksheets
Dim annualRateWS As Worksheet
Dim annualPSFWS As Worksheet
Dim annualFlatWS As Worksheet
Dim monthlyRateWS As Worksheet
'Set template Worksheets
Set annualRateWS = Worksheets("00_ComRate_Template")
Set annualPSFWS = Worksheets("00_PSF_Template")
Set annualFlatWS = Worksheets("00_FlatAmount_Template")
Set monthlyRateWS = Worksheets("00_MONTHLYTEMPLATE")
'Set sourceSheet to Annual or Monthly table based on user input
Select Case MonthForm.OptionButton16.Value
Case "True"
Set sourceSheet = ThisWorkbook.Worksheets("Annual_InvoiceGen")
Case "False"
Set sourceSheet = ThisWorkbook.Worksheets("Monthly_InvoiceGen")
End Select
'Set path of directory all invoices are saved too
FolderPath = ("P:\Regis Profiles\00_MerchantDB\XX_TempDump\")
'Code used to stop screen flashing during macro operation -- This is set back to true after loop
Application.ScreenUpdating = False
'ANNUAL COMMISSION RATE - PDF GENERATION
If MonthForm.OptionButton16.Value = "True" And MonthForm.OptionButton7.Value = "True" Then
annualRateWS.Visible = True
annualRateWS.Activate
ThisWorkbook.Connections("Staging_AnnualLastEntry").Refresh
annualRateWS.Calculate
Workbook_BeforePrint (False)
'Application.Wait (Now + TimeValue("0:00:03"))
For i = 32 To 43 'This Code Hides All Calculation Years that are out of range*****
ActiveSheet.Rows(i).Hidden = (ActiveSheet.Cells(i, 5).Value = 0)
Next i
annualRateWS.Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & ThisWorkbook.Worksheets("REF_InvoiceGen").Range("$B$2").Value & Format(Now(), "yyyymmddhhmmss"), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
annualRateWS.Visible = False
End If
'ANNUAL COMMISSION PSF - PDF GENERATION
If MonthForm.OptionButton16.Value = True And MonthForm.OptionButton8.Value = "True" Then
annualPSFWS.Visible = True
annualPSFWS.Activate
ThisWorkbook.Connections("Staging_AnnualLastEntry").Refresh
annualPSFWS.Calculate
'Application.Wait (Now + TimeValue("0:00:03"))
annualPSFWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & ThisWorkbook.Worksheets("REF_InvoiceGen").Range("$B$2").Value & Format(Now(), "yyyymmddhhmmss"), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
annualPSFWS.Visible = False
End If
'ANNUAL FLAT AMOUNT = PDF GENERATION
If MonthForm.OptionButton16.Value = True And MonthForm.OptionButton9.Value = "True" Then
annualFlatWS.Visible = True
annualFlatWS.Activate
ThisWorkbook.Connections("Staging_AnnualLastEntry").Refresh
annualFlatWS.Calculate
'Application.Wait (Now + TimeValue("0:00:03"))
annualFlatWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & ThisWorkbook.Worksheets("REF_InvoiceGen").Range("$B$2").Value & Format(Now(), "yyyymmddhhmmss"), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
annualFlatWS.Visible = False
End If
'MONTHLY COMMISSION RATE - PDF GENERATION
If MonthForm.OptionButton16.Value = "False" And MonthForm.OptionButton7.Value = "True" Then
monthlyRateWS.Visible = True
monthlyRateWS.Activate
monthlyRateWS.Calculate
MonthlyTemp
MonthlyHide
'Application.Wait (Now + TimeValue("0:00:03"))
monthlyRateWS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FolderPath & ThisWorkbook.Worksheets("REF_InvoiceGen").Range("$B$2").Value & Format(Now(), "yyyymmddhhmmss"), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
monthlyRateWS.Visible = False
End If
sourceSheet.Visible = False
'Code used to set screen updating BACK TO True
Application.ScreenUpdating = True
End Sub
Tim Williams solved the problem. Background refresh was enabled on the connections. After disabling this, everything worked properly.

Can I optimize and speed up my VBA code

I am no VBA guru, but capable enough to stitch together the below code. It essentially formats a Invoice to hide any empty rows (populated with vlookups, but no value returns ""), set to 1 page portrait and export to PDF.
My issue is:
The code is taking way to long to run from start to finish.
Below is the VBA code I want to optimize and speed up.
Sub Save_Quote_As_PDF()
Application.ScreenUpdating = False
Dim a As Long
For a = 1 To ActiveSheet.Shapes.Count
On Error Resume Next
With ActiveSheet.Shapes.Item(a)
.Placement = xlMoveAndSize
.PrintObject = True
End With
Next a
On Error GoTo 0
ActiveSheet.Range("DCANUMBER").SpecialCells(4).EntireRow.Hidden = True
Dim PdfFilename As Variant
PdfFilename = Application.GetSaveAsFilename( _
InitialFileName:=ActiveWorkbook.Path & "\" & ActiveSheet.Range("N2").Value, _
FileFilter:="PDF, *.pdf", _
Title:="Save As PDF")
If PdfFilename <> False Then
With ActiveSheet.PageSetup
.Orientation = xlPortrait
.PrintArea = "$A$1:$K$78"
.PrintTitleRows = ActiveSheet.Rows(19).Address
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
End With
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=PdfFilename, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=False, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
End If
ActiveSheet.Range("DCANUMBER").SpecialCells(4).EntireRow.Hidden = False
Application.ScreenUpdating = True
End Sub
To hide the blank rows:
Dim ws As Worksheet
Set ws = ActiveSheet ' ActiveSheet is of type Object so using type Worksheet is a tiny bit faster
Dim row As Range ' again, specifying the type makes it a tiny bit faster
For Each row In ws.UsedRange.Rows ' .UsedRange to limit the range to only the used range
If row.Find("*") Is Nothing Then
row.EntireRow.Hidden = True
End If
Next
I don't think that hiding the rows is the slowest part of your code. You should time your code to see what parts are the slowest:
Dim start As Single
start = Timer
' part of the code
Debug.Print CDbl(Timer - start), "part 1" ' CDbl to avoid scientific notation
start = Timer ' remember to reset the start time
' another part of the code
Debug.Print CDbl(Timer - start), "part 2"

vba multiple sheets per pdf page

The below code generates a PDF file from a dynamic array of sheets. The second code sets the print area and print titles on the individual sheets of interest. Some of the sheets have multiple, discontinuous regions set to print.
Worksheets(sSheetsArray).Select
sFilename = "L:\[FilePath]" & Format(Now, "DD-MMM-YY-HH-MM") & "2.pdf"
Debug.Print sFilename
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=sFilename, _
Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=True
Sub to set print areas etc.
Sub SetWorksheetPrintArea(ws As Worksheet, sPrintAreas As String, sTitleRange As String, bLandscape As Boolean)
With ws.PageSetup
.PrintArea = sPrintAreas
.PrintTitleRows = sTitleRange
If bLandscape Then .Orientation = xlLandscape Else .Orientation = xlPortrait
.Zoom = False
.FitToPagesWide = 1
End With
End Sub
This works, however, I need to have one sheet produce pages side by side in the PDF. This should be similar to the way it would be presented on paper if set to booklet printing. Does anyone know how this could be done without re-arranging the layout of the sheet?

All columns of excelsheet are not fitted in same page of pdf; while converting using Excel VBA

Am trying to convert microsoft excel file with large number of columns (70+) into pdf using a Excel VBA code.
In active workbook, am trying to save 'Sheet1' to PDF format at required path. I have the following code.
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
With ActiveWorkbook
.Worksheets("Sheet1").ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
fileName, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
End If
End Sub
When am running the VBA code and saving the pdf file, I see that; the whole excelsheet is not fitted in same page. It's displaying some content in next page.
(Only few columns appear in first page, remaining appear on next page and so on..).
I checked with How to publish a wide worksheet in PDF format?.
But, setting page layout to landscape and converting excel file manually to PDF; also displays some columns in next pages.
There are many Free Excel to PDF Converters available online, which give me same results.
Is there any function available in VBA, through which I can fit all the columns in a single page of PDF?
The problem is with the Page Setup settings, I have done some minor changes to your code and added a procedure to perform the page setup settings, when launching the procedure you can select the paper size, however be aware the minimum zoom allowed is 10% (see PageSetup Members (Excel)). Therefore, if even at 10% the Print Area does not fit in one page I suggest to chose a larger paper size (i.e. A3) to generate an one page PDF, then when printing the Pdf select fit to page. The procedure also gives you the change to play with the margins, when generating PDF's I set all margins at 0, but you can changed as it fits your goals.
Sub Wsh_LargePrintArea_To_Pdf()
Dim WshTrg As Worksheet
Dim sFileName As String
sFileName = Application.GetSaveAsFilename( _
InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If sFileName <> "False" Then
Rem Set Worksheet Target
Set WshTrg = ActiveWorkbook.Worksheets("Sheet1")
Rem Procedure Update Worksheet Target Page Setup
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperLetter)
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA4)
'To Adjust the Page Setup Zoom select the Paper Size as per your requirements
'If the Print Still don't fit in one page then use a the largest Paper Size (xlPaperA3)
'When printing the Pdf you can still selet to fix to the physical paper size of the printer.
'Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperA3)
'This is the largest paper i can see in my laptop is 86.36 cm x 111.76 cm
Call Wsh_Print_Setting_OnePage(WshTrg, xlPaperEsheet)
Rem Export Wsh to Pdf
WshTrg.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=sFileName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End If
End Sub
Sub Wsh_Print_Setting_OnePage(WshTrg As Worksheet, ePaperSize As XlPaperSize)
On Error Resume Next
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0)
.FooterMargin = Application.InchesToPoints(0)
'.Orientation = xlLandscape
.Orientation = xlPortrait
.PaperSize = ePaperSize
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Application.PrintCommunication = True
End Sub
First select the range you want to print and set it as PrintArea. And then run this code, this work for me with an 79 columns sheet
Sub saveAsPDF()
Dim MyPath
Dim MyFolder
With Sheet1.PageSetup
'.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.BottomMargin = 0
.TopMargin = 0
.RightMargin = 0
.LeftMargin = 0
End With
MyPath = ThisWorkbook.Path
MyFolder = Application.GetSaveAsFilename(MyPath, "PDF Files (*.pdf),*.pdf")
If MyFolder = False Then Exit Sub
Sheet1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=MyFolder, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
End Sub
add this to your code, it will force everything to print on one sheet wide, but still let it print over multiple sheets tall
With Worksheets("Sheet1").PageSetup
.FitToPagesWide = 1
.FitToPagesTall = False
End With
also set your margins to "Narrow"
The problem is that you need to Select the UsedRange and then use Selection.ExportAsFixedFormat
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=False, _
IgnorePrintAreas:=False, OpenAfterPublish:=True
End If
End Sub
EDIT:
The problem was the PageSetupbecasue each page size has a maximum pixel limit as you were heading towards in your comment.
The Page Size is set to Oversize A0 which should more than cater for your 100x1500 UsedRange. Here you change the page size with the FitToPages... = 1 to check that your Range is within the print lines.
The FitToPagesWide and FitToPagesTall is to fit everything onto one page.
Sub GetSaveAsFilename()
Dim fileName As String
fileName = Application.GetSaveAsFilename(InitialFileName:="", _
FileFilter:="PDF Files (*.pdf), *.pdf", _
Title:="Select Path and FileName to save")
If fileName <> "False" Then
'Suspending Communicaiton with Printer to Edit PageSetup via Scripting
Application.PrintCommunication = False
'Setting Page Setup
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
' Setting Page Size to 92x92 inch Should cater for your data
.PaperSize = 159
End With
'Enabling Communicaiton with Printer
Application.PrintCommunication = True
'Selecting the Used Range in the Sheet
ActiveWorkbook.Worksheets("Sheet1").UsedRange.Select
'Saving the Selection - Here is where the problem was
Selection.ExportAsFixedFormat Type:=xlTypePDF, fileName:=fileName, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=True, OpenAfterPublish:=True
End If
End Sub
Note that the Page will appear Blank, you will need to Zoom in alot to view the data

How to exclude 1 sheet from my save to pdf VBA macro

I have a VBA code that works well, apart from the fact that i don't know how to exclude one sheet from saving to the PDF. I would like the exclude the sheet named 'Control' from being included in the export and save to PDF. Any ideas how or where i should add this?
Thanks
Sub CreatePDF()
Dim saveAsName As String
Dim WhereTo As String
Dim sFileName As String
Dim ws As Worksheet
Dim myrange
' Retrieve information from Control sheet
Sheets("Control").Activate
Range("C4").Activate
periodName = ActiveCell.Value
Range("C5").Activate
saveAsName = ActiveCell.Value
Range("C6").Activate
WhereTo = ActiveCell.Value
Set myrange = Worksheets("Control").Range("range_sheetProperties")
' Check if Stamp-field has any value at all
' if not, add the current date.
If Stamp = "" Then Stamp = Date
' Assemble the filename
sFileName = WhereTo & saveAsName & " (" & Format(CDate(Date), "DD-MMM-YYYY") & ").pdf"
' Format all sheets as landsape, autofit to 1 page and provide header
For Each ws In ActiveWorkbook.Worksheets
With ws.PageSetup
Application.PrintCommunication = False
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.CenterHorizontally = True
.ScaleWithDocHeaderFooter = False
.AlignMarginsHeaderFooter = False
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
Application.PrintCommunication = True
DisplayHeader = Application.VLookup(ws.Name, myrange, 2, False)
If Not IsError(DisplayHeader) Then
.LeftHeader = "&L &""Arial,Bold""&11&K00-048DIVA: " & DisplayHeader
Else: .LeftHeader = "&L &""Arial,Bold""&11&KFF0000WORKSHEET NOT DEFINED IN CONTROL SHEET "
End If
.CenterHeader = "&C &""Arial,Bold""&11&K00-048" & periodName
End With
Next
' Save the File as PDF
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
sFileName, Quality _
:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
MsgBox "PDF document has been created and saved to : " & sFileName
' Make sure we open the Control sheet upon Exit
Sheets("Control").Activate
End Sub
You could hide the worksheet at the beginning of the code and then make it visible again at the end.
TESTED:
' Retrieve information from Control sheet
Sheets("Control").Visible = False
'YOUR PDF CREATION CODE
Sheets("Control").Visible = True
Sheets("Control").Activate
I ran into the same problem and just hid the sheet during the export function, then I brought it back... Here is the code:
'Hide the log sheet to exclude from export
ActiveWorkbook.Sheets("Log").Visible = xlSheetHidden
ActiveWorkbook.ExportAsFixedFormat Type:=xlTypePDF, FileName:=FilePath + Today + "\" + Range("H2").Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=True
'Bring back the log sheet to allow for editing
ActiveWorkbook.Sheets("Log").Visible = xlSheetVisible