Macro to print several worksheets does not work!
 

Can someone see why the below macro does not work?
At first it seems to work, it will print the first worksheet wit
correct range and correct format, but when the next and all othe
worksheets are printed, the format is all wrong (the range is printe
over 4 pages) and it also prints worksheet "Q", although it should b
excluded!

Sub Makro1()
ActiveWorkbook.Unprotect ("password")
ActiveSheet.Unprotect ("password")
Application.ScreenUpdating = False
Sheets("B").Select
Dim NamesToExclude As Variant
Dim wks As Worksheet
Dim AddrToPrint As String
NamesToExclude = Array("A", "Q")
AddrToPrint = "B4:O74"
For Each wks In ThisWorkbook.Worksheets
If wks.Visible = xlSheetVisible Then
If IsNumeric(Application.Match(wks.Name, NamesToExclude, 0)) Then
'skip it
Else
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.78740157480315)
.RightMargin = Application.InchesToPoints(0.393700787401575)
.TopMargin = Application.InchesToPoints(0.590551181102362)
.BottomMargin = Application.InchesToPoints(0.590551181102362)
.HeaderMargin = Application.InchesToPoints(0.393700787401575)
.FooterMargin = Application.InchesToPoints(0.393700787401575)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = True
.CenterVertically = True
.Orientation = xlPortrait
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
wks.Range(AddrToPrint).PrintOut preview:=False
End If
End If
Next wks
Sheets("A").Select
Range("A1").Select
Application.ScreenUpdating = True
ActiveSheet.Protect ("password")
ActiveWorkbook.Protect ("password")
End Sub

I would be very greatful for some hints about what the problem coul
be

--
ulfa
-----------------------------------------------------------------------
ulfah's Profile: http://www.excelforum.com/member.php...fo&userid=2920
View this thread: http://www.excelforum.com/showthread.php?threadid=50722

Macro to print several worksheets does not work!
 

My bet is this line:
With ActiveSheet.PageSetup

You're always working with the activesheet.

How about:
With wks.PageSetup

(I stopped looking after that.)

ulfah wrote:

Can someone see why the below macro does not work?
At first it seems to work, it will print the first worksheet with
correct range and correct format, but when the next and all other
worksheets are printed, the format is all wrong (the range is printed
over 4 pages) and it also prints worksheet "Q", although it should be
excluded!

Sub Makro1()
ActiveWorkbook.Unprotect ("password")
ActiveSheet.Unprotect ("password")
Application.ScreenUpdating = False
Sheets("B").Select
Dim NamesToExclude As Variant
Dim wks As Worksheet
Dim AddrToPrint As String
NamesToExclude = Array("A", "Q")
AddrToPrint = "B4:O74"
For Each wks In ThisWorkbook.Worksheets
If wks.Visible = xlSheetVisible Then
If IsNumeric(Application.Match(wks.Name, NamesToExclude, 0)) Then
'skip it
Else
With ActiveSheet.PageSetup
LeftHeader = ""
CenterHeader = ""
RightHeader = ""
LeftFooter = ""
CenterFooter = ""
RightFooter = ""
LeftMargin = Application.InchesToPoints(0.78740157480315)
RightMargin = Application.InchesToPoints(0.393700787401575)
TopMargin = Application.InchesToPoints(0.590551181102362)
BottomMargin = Application.InchesToPoints(0.590551181102362)
HeaderMargin = Application.InchesToPoints(0.393700787401575)
FooterMargin = Application.InchesToPoints(0.393700787401575)
PrintHeadings = False
PrintGridlines = False
PrintComments = xlPrintNoComments
CenterHorizontally = True
CenterVertically = True
Orientation = xlPortrait
Draft = False
PaperSize = xlPaperA4
FirstPageNumber = xlAutomatic
Order = xlDownThenOver
BlackAndWhite = False
Zoom = False
FitToPagesWide = 1
FitToPagesTall = 1
End With
wks.Range(AddrToPrint).PrintOut preview:=False
End If
End If
Next wks
Sheets("A").Select
Range("A1").Select
Application.ScreenUpdating = True
ActiveSheet.Protect ("password")
ActiveWorkbook.Protect ("password")
End Sub

I would be very greatful for some hints about what the problem could
be.

--
ulfah
------------------------------------------------------------------------
ulfah's Profile: http://www.excelforum.com/member.php...o&userid=29204
View this thread: http://www.excelforum.com/showthread...hreadid=507228

--

Dave Peterson