Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #1
    Membre régulier
    Homme Profil pro
    autre
    Inscrit en
    juin 2017
    Messages
    200
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Isère (Rhône Alpes)

    Informations professionnelles :
    Activité : autre

    Informations forums :
    Inscription : juin 2017
    Messages : 200
    Points : 86
    Points
    86

    Par défaut compteur progression exécution macro

    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
    34
    Private Sub CommandButton1_Click()
     
        'Macro : Sébastien Mathier - Excel-Pratique'
        'Tuto vidéo : http://www.blog-excel.com/barre-de-progression-excel/
     
        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!

  2. #2
    Membre expérimenté
    Homme Profil pro
    retraité
    Inscrit en
    juin 2012
    Messages
    933
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : Belgique

    Informations professionnelles :
    Activité : retraité
    Secteur : Associations - ONG

    Informations forums :
    Inscription : juin 2012
    Messages : 933
    Points : 1 513
    Points
    1 513

    Par défaut

    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.

Discussions similaires

  1. Exécution macro avec une fonction intégré
    Par kiwi31 dans le forum VBA Access
    Réponses: 13
    Dernier message: 22/05/2007, 16h18
  2. [Macro]Exécution macro, message Erreur 3441
    Par samca dans le forum IHM
    Réponses: 1
    Dernier message: 25/04/2007, 20h17
  3. protection feuille + exécuter macros
    Par Fab_nabou dans le forum Macros et VBA Excel
    Réponses: 19
    Dernier message: 04/12/2006, 11h14
  4. Exécution Macro Excel à partir d'Access
    Par SylvainJ dans le forum Access
    Réponses: 1
    Dernier message: 11/08/2006, 14h58
  5. [VBA][Excel]Exécution macro avec fichiers source
    Par ouezon dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 24/12/2005, 00h00

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo