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

Claire_Brummell

Board Regular
Joined
Sep 29, 2004
Messages
129
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?

Code:
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
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.

Forum statistics

Threads
1,144,684
Messages
5,725,760
Members
422,639
Latest member
i have a question

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top