Discussion :

[Chribusquets]

Qui pourrait m’aider à résoudre mon problème svp

Voila :
Je suis amené à lancer des impressions d’étiquettes (Plusieurs milliers parfois) pour des produits et j’ai cette petite macro qui fonctionne très très bien

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub incrementeditionetiamazon()
'Macro incrément+édition+boucle (Jusqu'à n° de ligne)
'(Plusieurs etiquettes par ligne (EX : ETI PRODUIT)
 
 
Dim x
 
For x = 1 To Range("Z29")
 
       Range("R19").Value = Range("R19").Value + 1
 
       ActiveWindow.SelectedSheets.PrintOut Copies:=Cells(29, 11).Value
Next x
 
End Sub

Dans cette macro la cellule citée comme R19 correspond à la ligne en court de traitement, alors que la celle nommée 29, 11 (Cellule Z29)
Correspond au nombre total de ligne du fichier de base de données
(Cette quantité peut être changée en fonction des besoins)

Je voudrai mettre dans ce fichier Excel une barre de progression qui me donne en % la progression de ma commande (Edition) à partir de ces deux cellules.
Je voudrai aussi que cette barre de progression s’affiche dès le lancement de la ci-dessus macro (Automatiquement)

Franchement si quelqu’un pouvait m’aider, cela serai vraiment géniale

Merci d’avance

Christian

[Theze]

Bonsoir,

La proc ci-dessous crée deux labels sur la feuille, 1 servant de fond, l'autre servant de barre de progression ensuite, ta boucle d'impression avec l'incrémentation du label servant de barre puis le traitement fini, destruction des labels. Pour voir le rendu, mets en commentaire la ligne pour l'impression et lance la proc depuis la feuille.
Avant tout, cocher la référence "Microsoft Form 2.0 Object Library" (Outils > Référence...) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
 
Sub incrementeditionetiamazon()
 
    Dim Fe As Worksheet
    Dim Ctrl As OLEObject
    Dim LblProgress As MSForms.Label
    Dim LblFond As MSForms.Label
    Dim LargeurLabel As Integer
    Dim HauteurLabel As Integer
    Dim R As Double
    Dim I As Long
    Dim x As Long
 
    Set Fe = Worksheets("Feuil1")
 
    'supprime les labels si par hazard ils existent
    'gère l'erreur dans le cas contraire
    On Error Resume Next
    Fe.Shapes("LblProgress").Delete
    Fe.Shapes("LblFond").Delete
    On Error GoTo 0
 
    'défini les dimensions
    LargeurLabel = 500
    HauteurLabel = 20
 
    With Fe
 
        'crée le label servant de fond
        Set Ctrl = .OLEObjects.Add(ClassType:="Forms.Label.1", _
                                   Link:=False, _
                                   DisplayAsIcon:=False, _
                                   Left:=Application.UsableWidth / 2 - LargeurLabel / 2, _
                                   Top:=Application.UsableHeight / 2, _
                                   Width:=LargeurLabel, _
                                   Height:=HauteurLabel)
 
            'passe l'objet à la variable afin d'utiliser les propriétés des labels
            Set LblFond = Ctrl.Object
 
            'défini certaines de ces dernières
            With LblFond
                .Name = "LblFond"
                .Caption = ""
                .BorderColor = vbBlue
                .BorderStyle = fmBorderStyleSingle
            End With
 
        'crée le label servant de barre de progression
        Set Ctrl = .OLEObjects.Add(ClassType:="Forms.Label.1", _
                                   Link:=False, _
                                   DisplayAsIcon:=False, _
                                   Left:=Application.UsableWidth / 2 - LargeurLabel / 2, _
                                   Top:=Application.UsableHeight / 2, _
                                   Width:=0, _
                                   Height:=HauteurLabel)
 
            'idem que plus haut
            Set LblProgress = Ctrl.Object
 
            With LblProgress
                .Name = "LblProgress"
                .Caption = ""
                .BackColor = vbBlue
            End With
 
 
    End With
 
    'rapport
    R = LargeurLabel / Range("Z29")
 
    'boucle d'impression
    For x = 1 To Range("Z29")
 
        Range("R19").Value = Range("R19").Value + 1
        LblProgress.Width = x * R
        DoEvents
 
        ActiveWindow.SelectedSheets.PrintOut Copies:=Cells(29, 11).Value
 
    Next x
 
    'destruction des labels
    On Error Resume Next
    Fe.Shapes("LblProgress").Delete
    Fe.Shapes("LblFond").Delete
    On Error GoTo 0
 
    Set Fe = Nothing
    Set Ctrl = Nothing
    Set LblProgress = Nothing
    Set LblFond = Nothing
 
End Sub

Hervé.

[kiki29]

Salut,pourquoi ne pas placer tout bêtement qqch comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.StatusBar = x & " \ " & Range("Z29")

dans ta boucle ?

[Chribusquets]

Salut,pourquoi ne pas placer tout bêtement qqch comme

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.StatusBar = x & " \ " & Range("Z29")

dans ta boucle ?

bonsoir,

Merci beaucoup
Mais j'ai mis cette ligne entre la derniere ligne de ma macro et le Endsub mais cela ne me donne rien quand je lance ma macro

Christian

[casefayere]

Bonsoir,
une idée comme une autre, tu importes l'USF en piece jointe, et dans ton code :
le tout à adapter, surtout les limites de la barre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub nimportequoi()
barimp.Show
barimp.BARPAT.Min = 1: barimp.BARPAT.Max = 300
barimp.Repaint
'..code
barimp.BARPAT = 20
'..code
barimp.BARPAT = 40
'..code
barimp.BARPAT = 60
'..code
barimp.BARPAT = 80
'..code
barimp.BARPAT = 100
'..code
barimp.BARPAT = 120
'..code
barimp.BARPAT = 140
'..code
barimp.BARPAT = 180
'..code
    barimp.BARPAT = 200
    Unload barimp
End Sub

[kiki29]

Mais j'ai mis cette ligne entre la derniere ligne de ma macro et le Endsub mais cela ne me donne rien quand je lance ma macro

Réfléchis un peu tout de même avant de faire n'importe quoi