Same PageSetup & Print code gives diffferent results

[Emeng]

Hi all


I have a macro which prints the active sheet in A3 format.

Sub PrintPlan ()
' Setup page to print 17 columns 1 page wide A3 portrait
'
' Keyboard Shortcut: Ctrl+Shift+P
   
    Dim LR As Long
       
    Application.ScreenUpdating = 0
    Application.PrintCommunication = False
   
    LR = Range("A" & Rows.Count).End(xlUp).Row
   
    With ActiveSheet.PageSetup
   
        .PrintArea = "A1:P" & LR
        .LeftMargin = Application.InchesToPoints(0.1)
        .RightMargin = Application.InchesToPoints(0.1)
        .TopMargin = Application.InchesToPoints(0.3)
        .BottomMargin = Application.InchesToPoints(0.5)
       
        HeaderMargin = Application.InchesToPoints(0)
        .FooterMargin = Application.InchesToPoints(0)
        .PaperSize = xlPaperA3
        .Orientation = xlPortrait
        .Zoom = False
       
        .FitToPagesWide = 1
        .FitToPagesTall = 2
                   
    End With
   
    Application.PrintCommunication = True
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
End Sub

However when the same code is attached to the back end of another macro (which creates the sheet) it prints A4.

'Print Parameters
  Dim lr As Long

  Application.ScreenUpdating = 0
  Application.PrintCommunication = False

  With ActiveSheet.PageSetup

  lr = Range("A" & Rows.Count).End(xlUp).Row + 50

  .PrintArea = "A1:P" & lr
  .LeftMargin = Application.InchesToPoints(0.1)
  .RightMargin = Application.InchesToPoints(0.1)
  .TopMargin = Application.InchesToPoints(0.3)
  .BottomMargin = Application.InchesToPoints(0.5)
  HeaderMargin = Application.InchesToPoints(0)
  .FooterMargin = Application.InchesToPoints(0)
  .PaperSize = xlPaperA3
  .Orientation = xlPortrait
  .Zoom = False
  .FitToPagesWide = 1
  .FitToPagesTall = 2

  End With

  Application.PrintCommunication = True

  'Option to print, then close

  MSG1 = MsgBox("Would you like to print a copy?", vbYesNo, "Print page")

  If MSG1 = vbYes Then

  ‘Ive also tried with the ‘Print Parameters to AppPrintComTrue section in here
 
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False
 
Application.DisplayAlerts = False
  ThisWorkbook.Close SaveChanges:=False
  Application.ScreenUpdating = True
  Else
  Application.DisplayAlerts = False
  ThisWorkbook.Close SaveChanges:=False
  Application.ScreenUpdating = True
  End If
End Sub

I don’t understand why?

I have rearranged, modified, checked the net but no success.

Any help much appreciated.


Regards


Mark

 

[Hui]

Are you sure this code is executing?

In the second macro click in the line "Application.ScreenUpdating = 0" and press F9
Run the code as per normal and it will now stop at this line
now press F8 and it executes one line and advances to the next
Keep pressing F8 and observe what happens

If it doesn't stop at this line check that you have added it to the correct location or renamed it appropriately

 

[Emeng]

Hi Hui


I followed your directions and all went well; the page printed as it would using the first code example.


It seems the code is not executing. Any ideas why?


Regards


Mark

 

[Emeng]

Hi again

This is the whole code I've appended to the original macro, all of which executes as expected, except for this issue.

'EXTRAS
   
'Name sheet, apply colour according to WrkCtr, set Print Parameters, Option to Print a copy & close ThisWorkbook without saving.

    'Name sheet
   
        With ActiveWorksheet
       
        Rows("1:1").Insert
        Cells(1, 1).Formula = "=CONCATENATE(Left(A4,4),"" WK "",TEXT(WEEKNUM(D4,21),""00""))"
        Range("A1:P1").Select
        With Range("A1:P1")
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlBottom
            .MergeCells = True
        End With
       
        With Range("A1:P1").Font
            .Name = "Calibri"
            .Size = 24
            .Bold = True
        End With
       
       
    'Apply header colour
       
        Dim WrkCtr As String
        WrkCtr = Range("A4").Value
           
            With Range("A1:P1").Interior
                If InStr(1, (WrkCtr), "MUME") > 0 Then  'InStr checks for text in string
                Range("A1:P1").Interior.Color = 5287936
                ElseIf InStr(1, (WrkCtr), "MUMB") > 0 Then
                    With Range("A1:P1").Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorAccent6
                        .TintAndShade = 0.399975585192419
                        .PatternTintAndShade = 0
                    End With
                ElseIf InStr(1, (WrkCtr), "MLVM") > 0 Then
                Range("A1:P1").Interior.Color = 49407
                Else: Range("A1:P1").Interior.Color = 12611584
                End If
            End With
           
            Cells(1, 1).Value = Cells(1, 1).Value
            Rows(1).AutoFit
            Columns(6).AutoFit
       
                       
            'Print Parameters
               
                Dim lr As Long
       
                Application.ScreenUpdating = 0
                Application.PrintCommunication = False

                With ActiveSheet.PageSetup

                lr = Range("A" & Rows.Count).End(xlUp).Row + 50
               
                    .PrintArea = "A1:P" & lr
                    .LeftMargin = Application.InchesToPoints(0.1)
                    .RightMargin = Application.InchesToPoints(0.1)
                    .TopMargin = Application.InchesToPoints(0.3)
                    .BottomMargin = Application.InchesToPoints(0.5)
                   
                    HeaderMargin = Application.InchesToPoints(0)
                    .FooterMargin = Application.InchesToPoints(0)
                    .PaperSize = xlPaperA3
                    .Orientation = xlPortrait
                    .Zoom = False
                    .FitToPagesWide = 1
                    .FitToPagesTall = 2
                End With
                Application.PrintCommunication = True
    'Option to print, then close

        MSG1 = MsgBox("Would you like to print a copy?", vbYesNo, "Print page")

            If MSG1 = vbYes Then

                    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False

               
                Application.DisplayAlerts = False
                ThisWorkbook.Close SaveChanges:=False
                Application.ScreenUpdating = True
            Else
                Application.DisplayAlerts = False
                ThisWorkbook.Close SaveChanges:=False
                Application.ScreenUpdating = True
               
            End If

    End With
End Sub

 

[Hui]

Can you attach the whole file ?

 

[Emeng]

The macro file must reside in a folder called Planning Tools on the desktop.

Regards Mark

 

[Hui]

Try changing:

Old:

 'Print Parameters
   
  Dim lr As Long
   
  Application.ScreenUpdating = 0
  Application.PrintCommunication = False
   
  With ActiveWorksheet.PageSetup

New:

 'Print Parameters
   
  Dim lr As Long
   
  Application.ScreenUpdating = 0
  Application.PrintCommunication = False
   
  With Activesheet.PageSetup

The code block is already inside an active With ActiveWorksheet function

 

[Emeng]

Works like a bought one!

Four little letters...

Thanks Hui