Selection Print with Macro Button - Private Module or Quick Print in 2007

[Myproblem]

I try to imitate Quick Print option in Excel 2007 in the way to select range which should (selection)be printed but named Quick Print option do not fit because it print not just selection but all data in sheet.
Targe is to make vba - macro button similar to Quick Print option in Excel 2007 (in private module) which would do job: print only selection (without any other data to be printed in sheet).
I tried to search all vba related with topics, but failed.
Code below maybe start solution but for some reason it does not work
any idea, or solutions
thx

Public Sub cusPrintArea()
     
    Dim myRange As String
     
    myRange = Selection.Address
    ActiveSheet.PageSetup.PrintArea = myRange
     
    On Error GoTo 1
1:     Exit Sub
     
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
     
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
     
End Sub

 

[HaHoBe]

Hi, Myproblem,

maybe only two lines cause the problem:

Public Sub cusPrintArea()
     
    Dim myRange As String
     
    On Error GoTo 1
    myRange = Selection.Address
    ActiveSheet.PageSetup.PrintArea = myRange
     
     
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.5)
        .RightMargin = Application.InchesToPoints(0.5)
        .TopMargin = Application.InchesToPoints(0.5)
        .BottomMargin = Application.InchesToPoints(0.5)
        .HeaderMargin = Application.InchesToPoints(0.5)
        .FooterMargin = Application.InchesToPoints(0.5)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = False
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .PrintErrors = xlPrintErrorsDisplayed
    End With
     
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
1:     Exit Sub
     
End Sub

Ciao,
Holger

 

[Myproblem]

that is it, thx Holger