Anyone know why my fit to pages settings aren't saving?

[Claire_Brummell]

Hey

I've got a sub that works now, just one little glitch at the end. I set the fit to pages wide and fit to pages tall settings, but it doesn't retain them - so as soon as I go to print preview when the report has finished producing itself, it's just printing at normal 100% over as many pages as that takes.

Does anyone know why this is?

Sub Highlight_Report_All_Channels()

Dim SummarySheet As String
Dim Worksheet_Counter As Integer
Dim Sheet_Row_Counter As Long
Dim Summary_Row_Counter As Long
Dim Summary_Column_Counter As Integer
Dim Worksheet_Name
Dim Report_Month As Date
Dim CycleMonths As Integer
Dim CycleYears As Integer
Dim maxmonths As Integer

' Delete Current Highlights calendar
'Application.DisplayAlerts = False
'Sheets("Highlights Calendar").Delete
'Application.DisplayAlerts = True
'Add new sheet

Sheets.Add before:=Sheets(1)
'Sheets(1).Name = "Monthly Report - " & Format(Date, "mmmm")

' Get start and end dates for calendar

Report_Month = Application.InputBox(prompt:="Enter the month for the highlight report (enter 1st day of the month)", Title:="Highlight Report")

' Change new sheet name to Calendar from xx-xx-xxx to xx-xx-xxx

Sheets(1).Name = "Highlights (All) for " & Format(Report_Month, "mmm-yy")

' Set Summary sheet to be active sheet

SummarySheet = ActiveSheet.Name

    Sheets(SummarySheet).Rows("1:1").RowHeight = 24
    Sheets(SummarySheet).Columns("A:A").ColumnWidth = 25.14
    Sheets(SummarySheet).Columns("B:B").ColumnWidth = 10.57
    Sheets(SummarySheet).Columns("C:C").ColumnWidth = 12.43
    Sheets(SummarySheet).Columns("D:D").ColumnWidth = 35.71
    Sheets(SummarySheet).Columns("E:E").ColumnWidth = 40.29
    Sheets(SummarySheet).Columns("F:G").ColumnWidth = 12.57
    Sheets(SummarySheet).Columns("H:H").ColumnWidth = 12.29

' Set Header

Sheets(SummarySheet).Cells(1, 1).Value = "Highlights (All Channels) for " & Format(Report_Month, "mmm-yy")
With Sheets(SummarySheet).Cells(1, 1)
        .Interior.ColorIndex = 34
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .Font.Bold = "True"
        .Font.Size = 14
End With
With Sheets(SummarySheet).Range("A1:H1")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlVAlignCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
        .Borders.LineStyle = xlContinuous
End With



Summary_Row_Counter = 3

' Sorts worksheets
    
    For Worksheet_Counter = 2 To ActiveWorkbook.Sheets.Count - 3
    'MsgBox ("Sorting Sheet - " & Sheets(Worksheet_Counter).Name)
    If Worksheets(Worksheet_Counter).Range("A2") <> "" Then
        Worksheets(Worksheet_Counter).Range("A2").Sort _
        Key1:=Worksheets(Worksheet_Counter).Columns("A"), _
        Order1:=xlAscending, _
        Header:=xlYes
    End If
    Next Worksheet_Counter


For Worksheet_Counter = 2 To ActiveWorkbook.Sheets.Count - 1

' Set Header for each worksheet

    Sheets(SummarySheet).Cells(Summary_Row_Counter, 1).Value = Sheets(Worksheet_Counter).Name
    With Sheets(SummarySheet).Cells(Summary_Row_Counter, 1)
        .Interior.ColorIndex = 35
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .Font.Bold = "True"
        .Font.Size = 12
    End With
    With Sheets(SummarySheet).Range(Cells(Summary_Row_Counter, 1), Cells(Summary_Row_Counter, 8))
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlVAlignCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
        .Borders.LineStyle = xlContinuous
End With
    Sheets(SummarySheet).Rows(Summary_Row_Counter).RowHeight = 35.25
    Summary_Row_Counter = Summary_Row_Counter + 1

'Set Column Headings for each worksheet
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 1).Value = Sheets(Worksheet_Counter).Cells(1, 1).Value
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 2).Value = Sheets(Worksheet_Counter).Cells(1, 2).Value
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 3).Value = Sheets(Worksheet_Counter).Cells(1, 3).Value
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 4).Value = Sheets(Worksheet_Counter).Cells(1, 4).Value
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 5).Value = Sheets(Worksheet_Counter).Cells(1, 5).Value
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 6).Value = Sheets(Worksheet_Counter).Cells(1, 6).Value
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 7).Value = Sheets(Worksheet_Counter).Cells(1, 7).Value
    Sheets(SummarySheet).Cells(Summary_Row_Counter, 8).Value = Sheets(Worksheet_Counter).Cells(1, 8).Value
    With Sheets(SummarySheet).Range(Cells(Summary_Row_Counter, 1), Cells(Summary_Row_Counter, 8))
        .Interior.ColorIndex = 40
        .Borders.LineStyle = xlContinuous
        .Borders.ColorIndex = 0
        .WrapText = True
        .Font.Bold = "True"
        .Font.Size = 11
        .VerticalAlignment = xlCenter
        .HorizontalAlignment = xlCenter
    End With
    Sheets(SummarySheet).Rows(Summary_Row_Counter).RowHeight = 35.25
    Summary_Row_Counter = Summary_Row_Counter + 1
'Loop all active rows in the worksheet
    
    For Sheet_Row_Counter = 2 To Sheets(Worksheet_Counter).Rows.Count
    
    'Check the row has as value
    If Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 1) <> "" Then

        ' Check the highlight month falls in the dates given
        If Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 3) = Report_Month Then


                    'Enter the information
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 1).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 1).Value
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 2).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 2).Value
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 3).Value = Format(Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 3).Value, "mmm-yyyy")
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 4).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 4).Value
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 5).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 5).Value
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 6).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 6).Value
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 7).Value = Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 7).Value
                    Sheets(SummarySheet).Cells(Summary_Row_Counter, 8).Value = Format(Sheets(Worksheet_Counter).Cells(Sheet_Row_Counter, 8).Value, "hh:mm")
                    With Sheets(SummarySheet).Range(Cells(Summary_Row_Counter, 1), Cells(Summary_Row_Counter, 8))
                        .Interior.ColorIndex = 15
                        .Borders.LineStyle = xlContinuous
                        .Borders.ColorIndex = 0
                        .Font.Bold = "True"
                        .Font.Size = 10
                        .VerticalAlignment = xlCenter
                        .HorizontalAlignment = xlCenter
                    End With
                    Sheets(SummarySheet).Rows(Summary_Row_Counter).AutoFit
                    Summary_Row_Counter = Summary_Row_Counter + 1
            
        'End If -  Check the highlight month falls in the dates given
        End If
    
    'End If - Check the row has as value
    End If
       
    Next Sheet_Row_Counter
 
 
       ' Sheets(SummarySheet).Cells(i - 1, 1).Value = Sheets(i).Name
       ' Sheets(SummarySheet).Cells(i - 1, 2).Value = Sheets(i).Range("D65536").End(xlUp).Value
Next Worksheet_Counter


Cells.Select
With Selection
    .VerticalAlignment = xlVAlignCenter
    .HorizontalAlignment = xlHAlignCenter
    .WrapText = True
End With

      Sheets(SummarySheet).Select
    Sheets(SummarySheet).Move
    ChDir "S:\Brand\Third Party channels\Third Party Matrix\Highlight Reports - All Channels"
    ActiveWorkbook.SaveAs Filename:="S:\Brand\Third Party channels\Third Party Matrix\Highlight Reports - All Channels\" & Format(Date, "yy-mm-dd") & " - Highlight Report (All Channels) for " & Format(Report_Month, "mmm-yyyy") & ".xls", FileFormat:=xlNormal

Cells(1, 1).Select
    With ActiveSheet.PageSetup
        .Orientation = xlLandscape
        .FitToPagesWide = 1
        .FitToPagesTall = 1
        .CenterHeader = "Highlight Report (All Channels) - " & Format(Report_Month, "mmm-yyyy")
        .RightFooter = "Date Created - " & Format(Date, "dd-mmm-yyyy")
    End With
    ActiveWorkbook.Save

End Sub