barre de progression impression mise en page

[steph.777]

bonjour le forum

je comprend pas ce code qui fonctionnait , s'arrete a MAINTENANT 33%

ERREUR 1004 La methode select de woorksheet a echoué

merci pour votre aide stephane
stephane



Sub Noir_et_blanc()

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 userfbarrenoir
.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😕bloque la
ActiveSheet.PageSetup.PrintArea = "$A$1:$W$55"
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)
.FooterMargin = Application.InchesToPoints(0)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = -3
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = True
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = True
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
End With
'apercu
'ActiveWindow.SelectedSheets.PrintPreview

Next oWsh

Application.ScreenUpdating = True

Unload userfbarrenoir

End Sub

 

[Guest]

Re : barre de progression impression mise en page

Hello Steph,

N'aurais-tu pas une feuille cachée?

si oui mettre sa propriété Visible à xlSheetVisible

A bientôt

 

[steph.777]

Re : barre de progression impression mise en page

bonjour hasco

pas idiot cela

je regarde

merci

steph

 

[steph.777]

Re : barre de progression impression mise en page

re

s'est cela pb de fichier caché vraiment merci

une autre question
comment ne pas mettre en page les 11 premiers pages sachant que la 11 ieme page est la feuille caché

merci
steph

 

[Guest]

Re : barre de progression impression mise en page

Re bonjour Steph

J'ai un peu modifié la macro.

Celle-ci ne sélectionne plus les feuilles, les opérations sont donc transparentes pour l'utilisateur. Mais si c'est absolument nécessaire tu peux facilement répablir les choses.

Sub Noir_et_blanc()
    Application.ScreenUpdating = False
    Dim iWsh As Integer
    Dim oWsh As Worksheet
    Dim PctDone As Single
   [COLOR=red]Dim i As Integer[/COLOR]
    iWsh = ThisWorkbook.Worksheets.Count
   [COLOR=red]For i = 12 To iwhs[/COLOR]
        [COLOR=red]Set oWsh = Worksheets(i)[/COLOR]
[COLOR=red]       PctDone = i / (iWsh - 11)[/COLOR]
        With userfbarrenoir
            .FrameProgress.Caption = Format(PctDone, "0%")
            .LabelProgress.Width = PctDone * (.FrameProgress.Width - 10)
        End With
        ' The DoEvents statement is responsible for the form updating
        DoEvents
        [COLOR=red]With oWsh[/COLOR]
            .PageSetup.PrintArea = "$A$1:$W$55"
            [COLOR=red]With .PageSetup[/COLOR]
                .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)
                .FooterMargin = Application.InchesToPoints(0)
                .PrintHeadings = False
                .PrintGridlines = False
                .PrintComments = xlPrintNoComments
                .PrintQuality = -3
                .CenterHorizontally = False
                .CenterVertically = False
                .Orientation = xlLandscape
                .Draft = True
                .PaperSize = xlPaperA4
                .FirstPageNumber = xlAutomatic
                .Order = xlDownThenOver
                .BlackAndWhite = True
                .Zoom = False
                .FitToPagesWide = 1
                .FitToPagesTall = 1
            End With [COLOR=red]'PageSetUp[/COLOR]
        [COLOR=red]End With 'oWsh[/COLOR]
        'apercu
        [COLOR=red]'oWhs.PrintPreview[/COLOR]
    Next i
    Application.ScreenUpdating = True
    Unload userfbarrenoir
End Sub

A bientôt

 

[steph.777]

Re : barre de progression impression mise en page

merci hasco
mais elle ne fonctionne pas, ou plutot elle se lance sans la barre de defillement et en 1 seconde s'est fini
alors que normalement la durer de mise en page est de 40 seconde

a+ steph

 

[steph.777]

Re : barre de progression impression mise en page

trouver
iwhs au lieu de iWsh

par contre le % demare a 33 et fini a 133 environ

a+ steph et merci

 

[steph.777]

Re : barre de progression impression mise en page

re
la modif qui fonctionne
For i = 11 To iWsh
Set oWsh = Worksheets(i)
PctDone = (i - 11) / (iWsh - 11)

les 11 premieres feuilles ne seront pas mis en page

a bientot et merci hasco

steph