PDA

View Full Version : vba excel macro for print button



kellie1
02-24-2020, 10:43 AM
I need to add code to an existing macro. This addtl code will allow the user, when they receive the workbook, to select the print button which will open the print screen selection box at which point they can select their printer. The print window already needs to have the print what section selected as 'entire workbook'.

I have created the print button in the attachment with the code on a tab.

kellie1
02-27-2020, 06:31 AM
I have progressed a little farther with getting this to workbut when the workbook is emailed to the end user the print button does notwork. What am I missing in getting thisto work?



[Sub ZDSR2()

'
' ZDSR Macro
'


'start formatting workbook
Sheets(Array("Summary", "Total Americas","North America", "Latin America", _
"AsiaPacific", "EMEA", "Total US", "Total BV","Total Sonneborn")).Select
Sheets("Summary").Activate
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&A"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.75)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 40
.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
Sheets("Summary").Select
Application.CutCopyMode = False
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 59
.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
Sheets("TotalAmericas").Select
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication= False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall= 59
.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
Sheets("NorthAmerica").Select
Application.CutCopyMode = False
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 59
.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
Sheets("LatinAmerica").Select
Application.CutCopyMode = False
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 59
.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
Sheets("AsiaPacific").Select
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication= False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall= 59
.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
Sheets("EMEA").Select
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter = ""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 59
.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
Sheets("TotalUS").Select
Application.CutCopyMode = False
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader = ""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 59
.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
Sheets("TotalBV").Select
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines= False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 59
.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
Sheets("TotalSonneborn").Select
Application.PrintCommunication = False
WithActiveSheet.PageSetup
.PrintTitleRows = "$1:$3"
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader =""
.CenterHeader= ""
.RightHeader =""
.LeftFooter =""
.CenterFooter= "&D"
.RightFooter =""
.LeftMargin =Application.InchesToPoints(0)
.RightMargin =Application.InchesToPoints(0)
.TopMargin =Application.InchesToPoints(0.5)
.BottomMargin= Application.InchesToPoints(0.5)
.HeaderMargin= Application.InchesToPoints(0.3)
.FooterMargin= Application.InchesToPoints(0.3)
.PrintHeadings= False
.PrintGridlines = False
.PrintComments= xlPrintNoComments
.PrintQuality= 600
.CenterHorizontally = True
.CenterVertically = False
.Orientation =xlLandscape
.Draft = False
.PaperSize =xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order =xlDownThenOver
.BlackAndWhite= False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 59
.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
Sheets("Summary").Select




'print button

Const dHEIGHT As Double = 1.2
Const dWIDTH As Double = 0.9

Dim shp As Shape

Set shp =ActiveSheet.Shapes.AddShape(msoShapeRectangle, 11.25, 76.5, 51, 17.25)

With shp

.Name ="btnPrint"

.TextFrame2.TextRange.Characters.Text = "PRINT"

With.TextFrame2.TextRange.Characters(1, 5)

.ParagraphFormat.FirstLineIndent = 0
.ParagraphFormat.Alignment = msoAlignLeft

With .Font

.NameComplexScript = "+mn-cs"
.NameFarEast = "+mn-ea"
.Size= 11
.Name= "+mn-lt"

With.Fill

.ForeColor.ObjectThemeColor = msoThemeColorLight1
.ForeColor.TintAndShade = 0
.ForeColor.Brightness = 0
.Transparency = 0
.Visible = msoTrue
.Solid

EndWith

End With

End With

.ScaleHeight1.1304347826, msoFalse, msoScaleFromTopLeft
.ScaleWidth0.8529411765, msoFalse, msoScaleFromTopLeft

.OnAction ="PRINTWORKBOOK"


.Application.Dialogs(xlDialogPrint).Show , , , , , , , , , , , 3 ' <<< Insert the appropriateroutine name here

End With


ActiveSheet.Range("A9").Select



End Sub]