Discussion :

[swiches]

Bonjour,

Je fais un peu de vba en amateur et la je bloque.

J'ai une macro simple, qui copie chaque feuille dans une feuille nommée "Glob"

Aujourd'hui il n'y a que quelques feuilles, mais l'utilisateur à la possibilité d'ajouter autant de feuille qu'il ne souhaite.

J'aimerais implémenter une barre de progression, indiquant ou en est la procédure (10% 15% etc)

Cependant, j'ai essayé plusieurs fois, j'ai bien le graphisme que je veux, mais la barre reste a 1% et ... c'est tout.

Quelqu'un a t'il une idée?

En PJ mon fichier. je n'ai laissé dans userform que le graphisme que je souhaite. En attendant, j'ai mis une statusbar, mais c'est très discret.

merci d'avance,

Jonathan

[Jean-Philippe André]

Bonjour,

il y a peu de chance que les gens ouvrent ton fichier, pour des raisons evidentes de securite

Quelques pistes pour les barres de progression :
http://www.developpez.net/forums/d12...facon-patosch/
http://www.developpez.net/forums/d15...ss-bar-pacman/

[patricktoulon]

Bonjour

jean phillipe andre je crois qu'il avais déjà péché ma contrib "facon patosh"

je crois qu'il ne sais pas comment l'adapter

c'est tout simple voila sa macro tel qu'elle avec ma progressbar

les lignes de code ajoutée sont en vert sa donne une idée du "a quel point elle universelle et facilement applicable dans tout nouveau module "
voila sa fonction

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
Sub Fitest2()
'
' Macro2 Macro
'
UserForm1.Show 0
UserForm1.Repaint
Dim EtatStatusBar As Boolean
'état de la barre d'état
EtatStatusBar = Application.DisplayStatusBar
'affichage de la barre d'état
Application.DisplayStatusBar = True
'affichage du message
Application.StatusBar = "Données en cours de regroupement..."
  Dim Lig     As Long
  Dim Col     As String
  Dim NbrLig  As Long
  Dim NumLig  As Long
  
  Dim Sh As Worksheet
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.FilterMode Then 'Si on ne voit pas toutes les données
            Sh.ShowAllData
        End If
    Next
Application.ScreenUpdating = False
   
 Application.Calculation = xlCalculationManual
 
  With Worksheets("glob")
  .Rows("1:1048576").EntireRow.Delete
End With
  
 
  
  Sheets("glob").Activate ' feuille de destination
  
  Col = "A"                 ' colonne de la donnée non vide à tester
  NumLig = 0
  For i = 1 To Sheets.Count
  If Sheets(i).Name <> "glob" Or Sheets(i).Name <> "Mode emploi" Then
  With Sheets(i)     ' feuille source
  NbrLig = .Cells(1048576, Col).End(xlUp).Row
  For Lig = 1 To NbrLig
    If .Cells(Lig, Col).Value = "1" Then
      .Cells(Lig, Col).EntireRow.Copy
      NumLig = NumLig + 1
      Sheets("glob").Cells(NumLig, 1).Insert Shift:=xlDown
      
     
    End If
  Next
  Progressbarre i, Sheets.Count
  End With
  End If
  Next i
  
    
     Sheets("CAROLINE").Select
   Rows("1:1").Select
    Selection.Copy
    Sheets("glob").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    
    Sheets("glob").Select
   Rows("2:1048576").Select
    Selection.ClearFormats
    
     Columns("B:B").Select
    Selection.NumberFormat = "m/d/yyyy"
    
     Columns("E:E").Select
    Selection.NumberFormat = "m/d/yyyy"
    
    Columns("A:A").Delete Shift:=xlToLeft
    Rows("1:1").Select
    
 Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.StatusBar = False
'remise à l'état d'origine
Application.DisplayStatusBar = EtatStatusBar
 Sheets("glob").Select
Rows("1:1").Select

unload userform1
End Sub

voila

[swiches]

En effet, j'avais essayé de me débrouiller, mais je n'arrivais pas à l'adapter.

C'est génial, merci beaucoup.

[IronHeavy]

Bonjour à tous!

Cette proposition de PatrickToulon correspond bien au besoin de ma fonction dont le temps d'exécution pourrait inquiéter d'autres utilisateurs (>1min).

J'ai tenté de l'intégrer à mon module, l'USf s'affiche normalement or la barre ne progresse pas convenablement, selon ce que j'indique comme argument:

- soit elle reste pleine pendant la majeure partie du déroulé, puis se vide vers la fin:

Code :

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

Progressbarre i, Range("A" & Rows.Count).End(xlUp).Row

- soit elle reste pleine pendant la majeure partie du déroulé, et se remplit encore plus vers la fin:

Code :

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

Progressbarre Range("A" & Rows.Count).End(xlUp).Row, i

- soit elle se vide progressivement si je saisis manuellement le nombre de lignes traitées

Code :

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

Progressbarre i, 4075

Mais du coup cela ne m'arrange pas! je souhaiterais que la barre progresse et que cette fonction puisse être transposée à d'autres modules comportant un nombre de lignes différentes!

Un ptit coup d'oeil de mécano en codage?

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
'Mise en page du tableau en supprimant les lignes vides, titres intercalaires,interlignes et images et défusionnant les cellules
 
Sub Misenpage()
 
    Dim feuil As Worksheet
    Dim Rg As Range, Rg1 As Range
    Dim Expression As String
    Dim i As Long
    Expression1 = ""
    Expression2 = "A-NOMENCLATURE DES INSTALLATIONS CLASSEES"
 
UserForm1.Show 0
UserForm1.Repaint
 
With Worksheets("Legifrance") 'Nom de la feuille à adapter
        Set Rg = .Cells.Find(what:=Expression1, LookIn:=xlValues, lookat:=xlWhole)
        Set Rg1 = .Cells.Find(what:=Expression2, LookIn:=xlValues, lookat:=xlWhole)
 
        If Not Rg Is Nothing Then
            'Supprime la plage de cellules
            .Range(Rg, Rg1).EntireRow.Delete
        End If
 
'Sauvegarder la barre d'état en place
    Barre_Actuelle = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
 
    'affichage de la barre avec le message
    Application.StatusBar = "Mise en page en cours d’exécution, veuillez patienter"
 
    'Traitement à faire
 
        For i = Range("A" & Rows.Count).End(xlUp).Row To 10 Step -1
         If Cells(i, 2) = "" Then
             Cells(i, 2).EntireRow.Delete
              End If
              If Cells(i, 2) = "A-NOMENCLATURE DES INSTALLATIONS CLASSEES" Then
             Cells(i, 2).EntireRow.Delete
              End If
              If Cells(i, 2) = "Désignation de la rubrique" Then
             Cells(i, 2).EntireRow.Delete
              End If
                If Cells(i, 3).MergeCells Then
                Cells(i, 3).MergeCells = False
                End If
                If Cells(i, 4).MergeCells Then
                Cells(i, 4).MergeCells = False
                End If
            Application.StatusBar = "Lignes en cours de mise en page : " & i
 Progressbarre i, Range("A" & Rows.Count).End(xlUp).Row
 
       Next i
 
        'message de fin
    Application.StatusBar = "Traitement fini, Merci de votre patience"
 
    '3 secondes d'attente
    Application.Wait Now + TimeValue("00:00:05")
 
    'restauration de l'état de départ
    Application.StatusBar = False
    Application.DisplayStatusBar = Barre_Actuelle
 
 Unload UserForm1
 
  End With
End Sub

Merci!

[patricktoulon]

salut Iron

c'est normal tu par de la fin vers le debut ,il te faut inverser l'incrémentation pour la progressbar je sais même plus ou elle est celle la tellement elle est vielle

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
 
Sub Misenpage()
 
    Dim feuil As Worksheet
    Dim Rg As Range, Rg1 As Range
    Dim Expression As String
    Dim i As Long
    Expression1 = ""
    Expression2 = "A-NOMENCLATURE DES INSTALLATIONS CLASSEES"
 
UserForm1.Show 0
UserForm1.Repaint
 
With Worksheets("Legifrance") 'Nom de la feuille à adapter
        Set Rg = .Cells.Find(what:=Expression1, LookIn:=xlValues, lookat:=xlWhole)
        Set Rg1 = .Cells.Find(what:=Expression2, LookIn:=xlValues, lookat:=xlWhole)
 
        If Not Rg Is Nothing Then
            'Supprime la plage de cellules
            .Range(Rg, Rg1).EntireRow.Delete
        End If
 
'Sauvegarder la barre d'état en place
    Barre_Actuelle = Application.DisplayStatusBar
    Application.DisplayStatusBar = True
 
    'affichage de la barre avec le message
    Application.StatusBar = "Mise en page en cours d’exécution, veuillez patienter"
 
    'Traitement à faire
 Dim a As Long
        For i = Range("A" & Rows.Count).End(xlUp).Row To 10 Step -1
         a = a + 1
         If Cells(i, 2) = "" Then
             Cells(i, 2).EntireRow.Delete
              End If
              If Cells(i, 2) = "A-NOMENCLATURE DES INSTALLATIONS CLASSEES" Then
             Cells(i, 2).EntireRow.Delete
              End If
              If Cells(i, 2) = "Désignation de la rubrique" Then
             Cells(i, 2).EntireRow.Delete
              End If
                If Cells(i, 3).MergeCells Then
                Cells(i, 3).MergeCells = False
                End If
                If Cells(i, 4).MergeCells Then
                Cells(i, 4).MergeCells = False
                End If
            Application.StatusBar = "Lignes en cours de mise en page : " & i
 Progressbarre a, Range("A" & Rows.Count).End(xlUp).Row
 
       Next i
 
        'message de fin
    Application.StatusBar = "Traitement fini, Merci de votre patience"
 
    '3 secondes d'attente
    Application.Wait Now + TimeValue("00:00:05")
 
    'restauration de l'état de départ
    Application.StatusBar = False
    Application.DisplayStatusBar = Barre_Actuelle
 
 Unload UserForm1
 
  End With
End Sub

comme le début est égal a 10 il y aura peut-être une adaptation a faire sur ce point aussi