Discussion :

[IronHeavy]

Bonjour ,à Tous!

Voulant faire tester une application VBA à mes collègues, l'un d'eux m'a fait remarquer la longueur d'exécution de celle ci. Je voudrais afficher un USF indiquant le progrès du travail en cours...

J'ai trouvé ceci, qui me parait pertinent:

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
Private Sub CommandButton1_Click()
 
    'Macro : Sébastien Mathier '
 
    Application.ScreenUpdating = False
 
    UserForm_demo.Height = 121.5
 
    compteur = 0
    progression = 0
 
    For ligne = 1 To 5000
        For col = 1 To 50
 
            compteur = compteur + 1
            Cells(ligne, col) = ligne + col
 
            If compteur Mod 2500 = 0 Then '=> sera exécuté 100x
 
                progression = progression + 1
                Image_barre.Width = progression * 1.5
                Label_barre.Caption = progression & "%"
                DoEvents
 
            End If
 
        Next
    Next
 
    Application.ScreenUpdating = True
    UserForm_demo.Height = 136.5
 
End Sub

et j'apprécierai l'intégrer à cela, entre For i et Next i :

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
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"
 
 
    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
 
        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
       Next i
 
 
        For Each Img In Sheets("Legifrance").Pictures
            Img.Delete
        Next Img
 
    End With
 
End Sub

Mon problème est que mes différents essais m'ont , au mieux permis d'afficher l'USF contenant une barre de progression fixe (soit pleine, soit vide)... pas moyen de calibrer le compteur selon mes données!

Help?

Merci!

[EricDgn]

Bonjour,

J'ai l'impression que vous faites 2 fois le même travail. En fait vous souhaitez simplement effacer tout ce qui se trouve au-dessus de la ligne "Désignation de la rubrique", et cette ligne.

Si c'est bien cela, alors ceci suffit:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Sub Misenpage()
    Dim Rg As Range, img As Object
    Worksheets("Legifrance").Select
    Cells.UnMerge   '--- défusionne toutes les cellules
    Set Rg = Cells.Find(What:="Désignation de la rubrique", After:=Range("A1"), _
                        LookIn:=xlValues, LookAt:=xlPart)
    If Not Rg Is Nothing Then
        Rows("1:" & Rg.Row).Delete
    End If
    For Each img In ActiveSheet.Pictures
        img.Delete
    Next img
End Sub

Attention: dans votre boucle For i = ... Next i, vous n'avez pas mis .Range mais Range (sans point), de ce fait ce qui est travaillé n'est pas nécessairement la feuille "Legifrance", mais la feuille active au moment où la macro est lancée. (Tester en étant sur la Feuil2 p.ex.)

Bonne continuation.