I'm currently working on a worksheet where I want to print a certain shape/picture on the header of the print page. Right now, I have saved the picture on my pc and call it from there. However, the workbook is going to be spread, and I just don't want everybody to download the picture. I have de picture currently in the same worksheet as what needs to be printed however it would be a dream if the picture could also be in a different worksheet within the workbook. The name of the picture = Logo. The code I use right now is when the picture is downloaded locally on the pc.
Dim PathLogo As String
PathLogo = Sheets("HOME").Range("BI78").Value
With ActiveSheet.PageSetup.RightHeaderPicture
.Filename = PathLogo
.Height = Application.CentimetersToPoints(1.5)
.Width = Application.CentimetersToPoints(1.5)
End With
With ActiveSheet.PageSetup
.PrintArea = "$A$2:$X$103"
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.HeaderMargin = 0
.TopMargin = Application.CentimetersToPoints(1.5)
.BottomMargin = Application.CentimetersToPoints(1)
.CenterHorizontally = True
.CenterVertically = True
.RightHeader = "&G"
.CenterHeader = "&B&16&U&K595959" & Worksheets("HOME").Range("AJ71").Value
.RightFooter = "&D" & " " & "&T"
End With
ActiveSheet.Range("A2:X103").PrintOut
Related
I'm trying to get a code which will automatically set the print view mode around a certain range of cells (selected cells - as it has to be dynamic) and remove the page number (PAGE 1 in black superposed on cells).
I have tried the following (below), however it doesn't work as it grabs all the sheet data and puts it on one page instead of just showing the selected range on one page.
Dim myRange As Range
Set myRange = Selection
ActiveWindow.View = xlPageBreakPreview
myRange.Select
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.708661417322835)
.RightMargin = Application.InchesToPoints(0.708661417322835)
.TopMargin = Application.InchesToPoints(0.748031496062992)
.BottomMargin = Application.InchesToPoints(0.748031496062992)
.HeaderMargin = Application.InchesToPoints(0.31496062992126)
.FooterMargin = Application.InchesToPoints(0.31496062992126)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
End Sub
So basically I want the selected cells to be highlighted (white) and put only on one page (no page breaks) and anything else in the sheet to be put outside of the print view (in that gray/black view).
Any thoughts would be welcome.
Thank you !
One thing to remember when recording macros is that default settings don't usually need to be mentioned, unless you're changing the figure.
So things like .LeftHeader = "" aren't needed unless you're specifically removing text from the left header - by default it's blank, and this code is just saying keep it blank.
The page number superimposed on the sheet is just because you're in Page Break Preview (your code puts you in that at the start). You only need to look at that view if you're manually changing the print - using code just stay in the Normal view (it's rare you have to Select anything with VBA before working with it).
This code worked for me:
Sub Test()
Dim PrintRange As Range
Set PrintRange = Selection
With PrintRange.Parent.PageSetup 'The Parent of Selection is the sheet.
Application.PrintCommunication = True
.PrintArea = PrintRange.Address
Application.PrintCommunication = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
End Sub
I have a chart that grows each day and currently it's spanning A-BC columns.
If I want to print the last page I don't get the Y-axis labels with the print.
How can I print a the last page and include the Y-axis labels so that the chart looks "complete"?
First you need to make sure the A-column has the Y-axis labels and nothing more. Resize the column so that it only have the labels and not the start of the chart.
Then we use VBA by copying the A-column and paste it as an image and move it to the print area, print the sheet and remove the image.
Sub print_last_page()
Set ws = ActiveSheet
'copy Y-axis lables, paste as image in B1 and rename the object to "Ylabels"
ws.Range("A1:A72").CopyPicture xlScreen, xlBitmap
ws.Range("B1").PasteSpecial
Selection.ShapeRange.Name = "Ylabels"
' this finds the last column the the chart named "Buffertpallplatser %" occupies
x = ws.Shapes("Buffertpallplatser %").Width
y = 0
With ws.Shapes.AddLine(x, y, x, y)
.TopLeftCell.Select
.Delete
End With
endcol = Selection.Column ' save this column for later use
' do the same thing again but roll back 750 pixels.
' 750 pixels is about what fits the paper with the given heights of my charts, change to suit you needs
x = ws.Shapes("Buffertpallplatser %").Width - 750
y = 0
With ws.Shapes.AddLine(x, y, x, y)
.TopLeftCell.Select
.Delete
End With
posleft = Selection.Left ' save this column also for later use.
ws.Shapes.Range(Array("Ylabels")).Left = posleft ' move the image to the left most position of our print area
ActiveCell.Select ' select the cell again
' resize the selection to the chart area, in my case 73 rows and the 750 pixels width in columns
Selection.Resize(Selection.Rows.Count + 73, endcol - Selection.Column + 1).Select
' Below is a recorded macro to print the selection and scale to fit the columns
' I advice you to record something that suits your case.
Application.PrintCommunication = False
With ws.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ws.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ws.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True
' remove the image from the sheet again.
ws.Shapes.Range(Array("Ylabels")).Delete
End Sub
If we step through the code it will generate this:
And the end result on paper will look like this:
I have been working on this macro for a few days now, and have hit a problem which I haven't been able to solve with my limited VBA knowledge. It works fine for the first two sheets, but after that it seems to be going wrong and not returning the correct ranges from the second workbook (MACRO Customs Invoices) or re-merging the cells in ThisWorkbook, so the end pdf doesn't have the information I want as is formatted all wrong. Please help me, good people! Your help would be hugely appreciated.
Sub VBAexperimentalv6()
Dim invoice As Workbook
Dim invoicews As Worksheet
Dim origlotno As Range
Dim invoiceci As Range
Dim macroci As Range
Dim remlotno As Range
Dim rhci As Range
Set invoice = ThisWorkbook
For Each invoicews In ThisWorkbook.Worksheets
invoicews.Activate
Set origlotno = Range("D15", Range("D15").End(xlDown))
Set invoiceci = Range("F15", Range("F15").End(xlDown))
Set remlotno = invoicews.Range("D15:E15")
Set remlotno = remlotno.Resize(origlotno.Rows.Count)
remlotno.UnMerge 'unmerges lot number column
With origlotno
Workbooks("MACRO Customs Invoices.xlsx").Sheets("Sheet1").Range("A2").Resize(.Rows.Count, .Columns.Count).Value2 = .Value2 'copies lot numbers from invoice to macro in dynamic ranges
End With
invoicews.Range("D5:K5").UnMerge 'unmerges client name cells
Workbooks("MACRO Customs Invoices.xlsx").Sheets("Sheet1").Range("M3").Value = invoicews.Range("D5").Value ' copies client name to formula sheet
Set macroci = Workbooks("MACRO Customs Invoices.xlsx").Sheets("Sheet1").Range("J2")
Set macroci = macroci.Resize(invoiceci.Rows.Count, invoiceci.Columns.Count)
invoiceci.Value = macroci.Value ' copies customs info into invoice
invoicews.Range("D5:K5").Merge 'merges client name
remlotno.Merge (True) ' merges lot no in variable range
invoicews.Rows("2:2").RowHeight = 60 ' sets address row to correct height
Set rhci = invoicews.Rows("15:15")
Set rhci = rhci.Resize(origlotno.Rows.Count)
rhci.RowHeight = 21 'resizes lot no rows to allow for two lines
Application.PrintCommunication = False
With invoicews.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
invoicews.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With invoicews.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.393700787401575)
.RightMargin = Application.InchesToPoints(0.196850393700787)
.TopMargin = Application.InchesToPoints(0.393700787401575)
.BottomMargin = Application.InchesToPoints(0.393700787401575)
.HeaderMargin = Application.InchesToPoints(0.393700787401575)
.FooterMargin = Application.InchesToPoints(0.393700787401575)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 300
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 0
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = False
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
invoicews.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"C:\Users\Richard\Documents\Sortcoding\Customs Invoices\" & Workbooks("MACRO Customs
Invoices.xlsx").Sheets("Sheet1").Range("M2").Value _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False ' saves as pdf using formula generated file name
Workbooks("MACRO Customs Invoices.xlsx").Sheets("Sheet1").Range("A2:A250").Clear ' clear formula sheet ready for next invoice
Next invoicews
End Sub
I am new to the wonders and world of Macro, VBA and RPA, and would like to study it more. Recently did a short course on RPA.
Just want to share my problem and throw a question out to the Community here.
My Pain Point:
I’m the person printing the Payslips for the Company.
Currently I am opening all 30+ Single Excel File Payslips generated by Excel VBA (not done by me) for my company one by one and setting to print by Set Print Area for EACH Payslip Standalone Excel File, and printing them one by one.
This takes up quite some time which I believe can be saved with either the right Print Settings, VBA or RPA.
Unfortunately I am still exploring these and know nothing about VBA.
Id like to check for VBA, how I can go about macro-ing the process such that I can ease my workflow in the following:
Opening Payslip one by one
Setting the Print Area (same throughout)
Printing
If any of these can be automated it'd save me time and frustration.
Regarding the code it might be a merge of these two
https://www.ablebits.com/office-addins-blog/2019/08/20/set-change-print-area-excel/
https://www.excelhowto.com/macros/print-all-workbooks-in-a-folder/
Anyone can advise step by step what I am to do? I have read and tried but do not understand still.
Tested and working.
This code loops files in a folder, selects A1:K41 and prints the selected range to your standard printer.
Sub run()
FolderPath = "PATH TO FOLDER"
FileNme = Dir(FolderPath & "\*.xlsx") ' returns the first xlsx file in the folder
Do While Len(FileNme) > 0 ' loop while there are files.
Set wb1 = Workbooks.Open(FolderPath & "\" & FileNme) ' open file
wb1.Sheets("Sheet1").Range("A1:K41").Select ' select the range
'below is recorded macro of print selected area
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Selection.PrintOut Copies:=1, Collate:=True
'close payslip
Application.DisplayAlerts = False
wb1.Close
Application.DisplayAlerts = True
FileNme = Dir ' get the next file name
Loop
End Sub
How can I copy the page setup, including the RightHeaderPicture from worksheet to another using VBA?
Can someone help me here?
Regards,
Antony Terrence
Based on barryleajo's answer, I came up with this code:
(The commented areas caused runtime errors)
Sub copyPageSetup(fromSheet, toSheet)
With toSheet.PageSetup
.AlignMarginsHeaderFooter = fromSheet.PageSetup.AlignMarginsHeaderFooter
' .Application = fromSheet.PageSetup.Application
.BlackAndWhite = fromSheet.PageSetup.BlackAndWhite
.BottomMargin = fromSheet.PageSetup.BottomMargin
.CenterFooter = fromSheet.PageSetup.CenterFooter
' .CenterFooterPicture = fromSheet.PageSetup.CenterFooterPicture
.CenterHeader = fromSheet.PageSetup.CenterHeader
' .CenterHeaderPicture = fromSheet.PageSetup.CenterHeaderPicture
.CenterHorizontally = fromSheet.PageSetup.CenterHorizontally
.CenterVertically = fromSheet.PageSetup.CenterVertically
' .Creator = fromSheet.PageSetup.Creator
.DifferentFirstPageHeaderFooter = fromSheet.PageSetup.DifferentFirstPageHeaderFooter
.Draft = fromSheet.PageSetup.Draft
' .EvenPage = fromSheet.PageSetup.EvenPage
' .FirstPage = fromSheet.PageSetup.FirstPage
.FirstPageNumber = fromSheet.PageSetup.FirstPageNumber
.FitToPagesTall = fromSheet.PageSetup.FitToPagesTall
.FitToPagesWide = fromSheet.PageSetup.FitToPagesWide
.FooterMargin = fromSheet.PageSetup.FooterMargin
.HeaderMargin = fromSheet.PageSetup.HeaderMargin
.LeftFooter = fromSheet.PageSetup.LeftFooter
' .LeftFooterPicture = fromSheet.PageSetup.LeftFooterPicture
.LeftHeader = fromSheet.PageSetup.LeftHeader
' .LeftHeaderPicture = fromSheet.PageSetup.LeftHeaderPicture
.LeftMargin = fromSheet.PageSetup.LeftMargin
.OddAndEvenPagesHeaderFooter = fromSheet.PageSetup.OddAndEvenPagesHeaderFooter
.Order = fromSheet.PageSetup.Order
.Orientation = fromSheet.PageSetup.Orientation
' .Pages = fromSheet.PageSetup.Pages
.PaperSize = fromSheet.PageSetup.PaperSize
' .Parent = fromSheet.PageSetup.Parent
.PrintArea = fromSheet.PageSetup.PrintArea
.PrintComments = fromSheet.PageSetup.PrintComments
.PrintErrors = fromSheet.PageSetup.PrintErrors
.PrintGridlines = fromSheet.PageSetup.PrintGridlines
.PrintHeadings = fromSheet.PageSetup.PrintHeadings
.PrintNotes = fromSheet.PageSetup.PrintNotes
.PrintQuality = fromSheet.PageSetup.PrintQuality
.PrintTitleColumns = fromSheet.PageSetup.PrintTitleColumns
.PrintTitleRows = fromSheet.PageSetup.PrintTitleRows
.RightFooter = fromSheet.PageSetup.RightFooter
' .RightFooterPicture = fromSheet.PageSetup.RightFooterPicture
.RightHeader = fromSheet.PageSetup.RightHeader
' .RightHeaderPicture = fromSheet.PageSetup.RightHeaderPicture
.RightMargin = fromSheet.PageSetup.RightMargin
.ScaleWithDocHeaderFooter = fromSheet.PageSetup.ScaleWithDocHeaderFooter
.TopMargin = fromSheet.PageSetup.TopMargin
.Zoom = fromSheet.PageSetup.Zoom
End With
End Sub
A bit bare-bones but you will get the idea by the time you have finished!
Apparently there is no easy way to copy the PageSetup object in its entirety so, assuming the workbook is open try the following:
Sub cpyPS()
Dim wsFrom As Worksheet, wsTO As Worksheet
Set wsFrom = Sheets("From")
Set wsTO = Sheets("To")
With wsTO.PageSetup
'there are nearly 50 properties
.AlignMarginsHeaderFooter = wsFrom.PageSetup.AlignMarginsHeaderFooter
.BlackAndWhite = wsFrom.PageSetup.BlackAndWhite
.BottomMargin = wsFrom.PageSetup.BottomMargin
'
'
.LeftMargin = wsFrom.PageSetup.LeftMargin
'
'
.Orientation = wsFrom.PageSetup.Orientation
'
'
.PaperSize = wsFrom.PageSetup.PaperSize
.RightHeaderPicture.Filename = wsFrom.PageSetup.RightHeaderPicture.Filename
.RightMargin = wsFrom.PageSetup.RightMargin
'
'
.TopMargin = wsFrom.PageSetup.TopMargin
'
'
.Zoom = wsFrom.PageSetup.Zoom
End With
End Sub
The full list of properties to consider is provided here.
Never mind, perhaps write it once as a function and post back for all to use?
You could always copy the whole sheet and rename it if this is doable for you. The properties will be 'taken across' as it were.