mise en page

[steve]

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

 

[JMG]

bonjour

tu n'as pas besoin du basic

si ton ordi est asez puissant tu peu selectionner toutes tes feuilles avec shift + click gauche derniere feuille et faire la mise page une seul fois

s'il n'est pas assez puissant plantage...

fait une sauvegarde avant

JMG

 

[steve]

Bonsoir

je sais qu'il est possible de faire comme ca

mais je veux absolument faire en vba.

merci pour ta reponse

a+ steve

 

[steve]

bonjour le forum

je suis dans l'impasse

merci de votre aide.

 

[wally]

Bonjour steve et le forum,

Voici ta macro légèrement remaniée. La mise en page se fait sur toutes les feuilles du classeur. La valeur affichée dans la barre de progression dépend du nombre de feuilles (p. ex. avec 4 feuilles, la barre de progression affichera successivement 25%, 50%, 75% et 100%). Mais rien ne t'empêche d'affiner un peu cet affichage...

Sub Main

Application.ScreenUpdating = False

Dim iWsh As Integer
Dim oWsh As Worksheet
Dim PctDone As Single

iWsh = ThisWorkbook.Worksheets.Count

For Each oWsh In ThisWorkbook.Worksheets

PctDone = oWsh.Index / iWsh

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
oWsh.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 oWsh

Application.ScreenUpdating = True

Unload userfbarre

End Sub


Slts

wally