C
Curt
Have code not right data sheet copies to announcer then I try to print
announcer. Not able to locate why does not expand cell for printing. On data
sheet cel is shrink to fit. somehow I am not getting shrink to fit off on
announcer. Here are the two modules that do it. Will pasteing into cells not
have same result as typeing?
Thanks to anyone & all
Private Sub OptionButton12_Click()
OptionButton12.Value = False
Application.EnableEvents = False
Worksheets("Data").Range("A5:A104,D5104,E5:E104,F5:F104,H5:H104,M5:M104").Copy
Worksheets("Announcer").Range("A2").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'Application.EnableEvents = True
Worksheets("Announcer").Activate
Range("G2").Select
Call Print_Announcer
End Sub
Sub Print_Announcer()
Dim pCnt As Integer
With Sheets("Announcer")
..pagesetup.printarea = "A2:F" & Cells(Rows.Count, "C").End(xlUp).Row
pCnt = Application.InputBox("How Many Copies from 1-9", Type:=1)
If pCnt < 1 Or pCnt > 9 Then Exit Sub
Sheets("Announcer").Select
Columns("F").Select
With Selection
Application.ScreenUpdating = False
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.MergeCells = False
With ActiveSheet.pagesetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -3
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
Application.ScreenUpdating = True
ActiveWindow.SelectedSheets.PrintOut copies:=pCnt, Collate:=True
End With
ActiveSheet.pagesetup.printarea = "c2:f4"
Columns("F").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
ActiveSheet.pagesetup.printarea = ""
End With
End With
End With
Application.ScreenUpdating = True
' Range("G4").Select
End Sub
announcer. Not able to locate why does not expand cell for printing. On data
sheet cel is shrink to fit. somehow I am not getting shrink to fit off on
announcer. Here are the two modules that do it. Will pasteing into cells not
have same result as typeing?
Thanks to anyone & all
Private Sub OptionButton12_Click()
OptionButton12.Value = False
Application.EnableEvents = False
Worksheets("Data").Range("A5:A104,D5104,E5:E104,F5:F104,H5:H104,M5:M104").Copy
Worksheets("Announcer").Range("A2").PasteSpecial Paste:=xlValues
Application.CutCopyMode = False
'Application.EnableEvents = True
Worksheets("Announcer").Activate
Range("G2").Select
Call Print_Announcer
End Sub
Sub Print_Announcer()
Dim pCnt As Integer
With Sheets("Announcer")
..pagesetup.printarea = "A2:F" & Cells(Rows.Count, "C").End(xlUp).Row
pCnt = Application.InputBox("How Many Copies from 1-9", Type:=1)
If pCnt < 1 Or pCnt > 9 Then Exit Sub
Sheets("Announcer").Select
Columns("F").Select
With Selection
Application.ScreenUpdating = False
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.MergeCells = False
With ActiveSheet.pagesetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.75)
.RightMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(1)
.BottomMargin = Application.InchesToPoints(1)
.HeaderMargin = Application.InchesToPoints(0.5)
.FooterMargin = Application.InchesToPoints(0.5)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -3
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperLetter
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
Application.ScreenUpdating = True
ActiveWindow.SelectedSheets.PrintOut copies:=pCnt, Collate:=True
End With
ActiveSheet.pagesetup.printarea = "c2:f4"
Columns("F").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
ActiveSheet.pagesetup.printarea = ""
End With
End With
End With
Application.ScreenUpdating = True
' Range("G4").Select
End Sub