S
steve
Guest
Bonjour le forum
PETIT PB
Comment faire la meme mise en page de toute les feuilles d'un classeur le plus rapidement possible en utilisant la macro "barre de progression " de john walkenbach.
j'ai essayer en mettant une boucle mais cela ne fonctionne pas ou mal.
merci pour vos solutions
Sub Main()
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer
Dim PctDone As Single
Dim z
Dim y
Dim chw
z = Sheets("test").Cells(14, 1)
' If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
' Cells.Clear
' Application.ScreenUpdating = False
For y = 2 To z
Counter = 0
RowMax = 2
ColMax = 25
For r = 1 To RowMax
For c = 1 To ColMax
'pour la défini
Counter = Counter + 1
Next c
PctDone = Counter / (RowMax * ColMax)
With userfbarre
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
chw = Sheets("test").Cells(y + 14, 1)
Sheets(chw).Select
ActiveSheet.PageSetup.PrintArea = "A1:S53"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next r
Next y
Unload userfbarre
End Sub
PETIT PB
Comment faire la meme mise en page de toute les feuilles d'un classeur le plus rapidement possible en utilisant la macro "barre de progression " de john walkenbach.
j'ai essayer en mettant une boucle mais cela ne fonctionne pas ou mal.
merci pour vos solutions
Sub Main()
Dim Counter As Integer
Dim RowMax As Integer, ColMax As Integer
Dim r As Integer
Dim PctDone As Single
Dim z
Dim y
Dim chw
z = Sheets("test").Cells(14, 1)
' If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
' Cells.Clear
' Application.ScreenUpdating = False
For y = 2 To z
Counter = 0
RowMax = 2
ColMax = 25
For r = 1 To RowMax
For c = 1 To ColMax
'pour la défini
Counter = Counter + 1
Next c
PctDone = Counter / (RowMax * ColMax)
With userfbarre
.FrameProgress.Caption = Format(PctDone, "0%")
.LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
End With
' The DoEvents statement is responsible for the form updating
DoEvents
chw = Sheets("test").Cells(y + 14, 1)
Sheets(chw).Select
ActiveSheet.PageSetup.PrintArea = "A1:S53"
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0)
.RightMargin = Application.InchesToPoints(0)
.TopMargin = Application.InchesToPoints(0)
.BottomMargin = Application.InchesToPoints(0)
.HeaderMargin = Application.InchesToPoints(0.511811023622047)
.FooterMargin = Application.InchesToPoints(0.511811023622047)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
Next r
Next y
Unload userfbarre
End Sub