Insertion barre de progression

Résolu
anesr Messages postés 27 Statut Membre -  
anesr Messages postés 27 Statut Membre -
Bonjour,

Je suis actuellement en train de travailler sur un document excel et j'ai un problème.
Je voudrai en faite mettre en place une barre de progression qui permet de visualiser l'état de progression de la macro.
J'ai visiter plusieurs forum et tenter plusieurs manipulation mais cela n'a rien donné

Si quelqu'un a une idée je serai ravi qu'il puisse me donner un coup de main.
Je vous joins mon fichier

MERCI D'AVANCE

http://cjoint.com/data/0BCpvwbfVEZ.htm

10 réponses

  1. foo
     
    Bonjour

    voila un model de barre

    http://cjoint.com/?3BCqMXV02L2

    A+

    Maurice
    0
  2. anesr Messages postés 27 Statut Membre
     
    Merci pour ta réponse Maurice, c'est sympa d'avoir pris le temps de répondre.
    Mais quand j'essai d'intégrer ta barre a mon fichier , j'ai toujours des problème ou bien elle se lance et ensuite ma macro derrière mais elle n'est pas syncro avec ma macro
    Dsl j'ai encore bcp de mal avec excel. -_-
    0
  3. foo
     
    Re
    pour mettre la barre il faut la mettre dans une boucle

    A+
    Maurice
    0
  4. anesr Messages postés 27 Statut Membre
     
    Maurice je reviens vers toi après quelques jours parce que j'ai encore des difficultés a insérer ma fameuse barre de progression...
    Voila ma grande boucle et l'endroit ou je veut insérer ma barre de progression

    Sub recherche(nom_tourelle As String)
    dernligne = Worksheets("donnees king").Range("A65536").End(xlUp).Row
    dernligne1 = Worksheets("King-37").Range("A65536").End(xlUp).Row
    critere = Worksheets(nom_tourelle).Name

    'insertion des titres
    Worksheets(nom_tourelle).Cells(9, 2).Value = "Designation(3.7)"
    Worksheets(nom_tourelle).Cells(9, 3).Value = "Orientation(3.7)"
    Worksheets(nom_tourelle).Cells(9, 4).Value = "Designation(3.2)"
    Worksheets(nom_tourelle).Cells(9, 5).Value = "Orientation(3.2)"
    Worksheets(nom_tourelle).Cells(9, 6).Value = "Poste"
    Worksheets(nom_tourelle).Cells(9, 7).Value = "Tourelle"
    Worksheets(nom_tourelle).Cells(9, 8).Value = "famille"
    Worksheets(nom_tourelle).Cells(9, 9).Value = "Ordre"
    Worksheets(nom_tourelle).Cells(9, 10).Value = "Angle Tourelle"
    Worksheets(nom_tourelle).Cells(9, 11).Value = "Rayon Tourelle"
    Worksheets(nom_tourelle).Cells(9, 12).Value = "OTX"
    Worksheets(nom_tourelle).Cells(9, 13).Value = "OTY"
    Worksheets(nom_tourelle).Cells(9, 14).Value = "Auto Index"

    'creation de la boucle pour recupurer les informations souhaitees
    For n = 10 To 67
    Num_outil = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 2).Value
    Ordre = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 1).Value
    Taille = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 3).Value
    Angle_Tourelle = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 5).Value
    Rayon_Tourelle = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 6).Value
    OTX = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 7).Value
    OTY = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 8).Value

    designation = "--"
    Orientation = "--"
    designation3_7 = "--"
    Orientation3_7 = "--"
    tourelle = "--"
    famille = "--"
    Auto_Index = "--"

    'info ActCut 3.2
    For j = 2 To dernligne
    If Worksheets("donnees king").Cells(j, 1).Value = critere Then
    If Worksheets("donnees king").Cells(j, 3).Value = Num_outil Then
    designation = Worksheets("donnees king").Cells(j, 2).Value
    Orientation = Worksheets("donnees king").Cells(j, 4).Value
    tourelle = Worksheets("donnees king").Cells(j, 1).Value
    famille = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 4).Value
    Auto_Index = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 9).Value
    GoTo suite1
    End If
    End If
    Next j
    suite1:

    'affichage des resultats 3.2
    Worksheets(nom_tourelle).Cells(n, 4).Value = designation
    Worksheets(nom_tourelle).Cells(n, 9).Value = Ordre
    Worksheets(nom_tourelle).Cells(n, 6).Value = Num_outil
    Worksheets(nom_tourelle).Cells(n, 7).Value = tourelle
    Worksheets(nom_tourelle).Cells(n, 8).Value = famille
    Worksheets(nom_tourelle).Cells(n, 5).Value = Orientation
    Worksheets(nom_tourelle).Cells(n, 10).Value = Angle_Tourelle
    Worksheets(nom_tourelle).Cells(n, 11).Value = Rayon_Tourelle
    Worksheets(nom_tourelle).Cells(n, 12).Value = OTX
    Worksheets(nom_tourelle).Cells(n, 13).Value = OTY
    Worksheets(nom_tourelle).Cells(n, 14).Value = Auto_Index

    'info ActCut3.7
    For x = 1 To dernligne1
    If Worksheets("King-37").Cells(x, 1).Value = critere Then
    If Worksheets("King-37").Cells(x, 3).Value = Num_outil Then
    designation3_7 = Worksheets("King-37").Cells(x, 2).Value
    Orientation3_7 = Worksheets("King-37").Cells(x, 4).Value
    famille = Worksheets("Tourelle Physique VIPROS KING").Cells(n, 4).Value
    GoTo suite2
    End If
    End If
    Next x
    suite2:

    'affichage des resultats 3.7
    Worksheets(nom_tourelle).Cells(n, 2).Value = designation3_7
    Worksheets(nom_tourelle).Cells(n, 3).Value = Orientation3_7
    Worksheets(nom_tourelle).Cells(n, 8).Value = famille

    INSERER LA BARRE DE PROGRESSION ICI
    Next n
    End Sub

    -----------------------------------------------------------------------------------------------------

    j'ai creer un UserForm avec un code qui est le suivant :

    Sub ActionRépétitive() 'ta boucle où tu fais ce que tu veux...
    Dim Nbredefois, UnitéDeLongueur, i 'etc
    Nbredefois = 58
    UnitéDeLongueur = Int(Règle.Width / Nbredefois)
    For i = 1 To Nbredefois
    insertion (UnitéDeLongueur)
    Next i
    End Sub

    Sub insertion(UnitéDeLongueur)
    Curseur.Visible = False
    LongueurCurseur = Aperçus.Curseur.Width + UnitéDeLongueur
    Aperçus.Curseur.Width = LongueurCurseur
    r = DoEvents
    Curseur.Visible = True
    End Sub

    Mais malgré cela sa ne marche toujours pas

    Si quelqu'un aurai une idée se serai très gentille de la faire partager.
    0

  5. Vous n’avez pas trouvé la réponse que vous recherchez ?

    Posez votre question
  6. foo
     
    Bonjour

    jespere que ca va marcher

    Sub recherche(nom_tourelle As String)
    Dim R As Long
    Dim ProgMaxWidth As Long
    Dim LastRow As Long
    ProgMaxWidth = 215
    LastRow = 65000
    U_ProBarre.Show vbModeless
    Dernligne = Worksheets("donnees king").Range("A" & Rows.Count).End(xlUp).Row
    'dernligne = Worksheets("donnees king").Range("A65536").End(xlUp).Row
    Dernligne1 = Worksheets("King-37").Range("A" & Rows.Count).End(xlUp).Row
    'Dernligne1 = Worksheets("King-37").Range("A65536").End(xlUp).Row
    critere = Worksheets(nom_tourelle).Name

    'insertion des titres
    With Worksheets(nom_tourelle)
    .Cells(9, 2).Value = "Designation(3.7)"
    .Cells(9, 3).Value = "Orientation(3.7)"
    .Cells(9, 4).Value = "Designation(3.2)"
    .Cells(9, 5).Value = "Orientation(3.2)"
    .Cells(9, 6).Value = "Poste"
    .Cells(9, 7).Value = "Tourelle"
    .Cells(9, 8).Value = "famille"
    .Cells(9, 9).Value = "Ordre"
    .Cells(9, 10).Value = "Angle Tourelle"
    .Cells(9, 11).Value = "Rayon Tourelle"
    .Cells(9, 12).Value = "OTX"
    .Cells(9, 13).Value = "OTY"
    .Cells(9, 14).Value = "Auto Index"
    End With
    'creation de la boucle pour recupurer les informations souhaitees
    U_ProBarre.Show vbModeless
    For N = 10 To 67
    If N Mod 10 = 0 Then
    U_ProBarre.Label1.Width = CInt(N * ProgMaxWidth / LastRow)
    U_ProBarre.Label1.Caption = Format(N / LastRow, "0%")
    U_ProBarre.Repaint
    End If

    Num_outil = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 2).Value
    Ordre = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 1).Value
    Taille = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 3).Value
    Angle_Tourelle = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 5).Value
    Rayon_Tourelle = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 6).Value
    OTX = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 7).Value
    OTY = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 8).Value

    designation = "--"
    Orientation = "--"
    designation3_7 = "--"
    Orientation3_7 = "--"
    tourelle = "--"
    famille = "--"
    Auto_Index = "--"

    'info ActCut 3.2
    For j = 2 To Dernligne
    If Worksheets("donnees king").Cells(j, 1).Value = critere Then
    If Worksheets("donnees king").Cells(j, 3).Value = Num_outil Then
    designation = Worksheets("donnees king").Cells(j, 2).Value
    Orientation = Worksheets("donnees king").Cells(j, 4).Value
    tourelle = Worksheets("donnees king").Cells(j, 1).Value
    famille = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 4).Value
    Auto_Index = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 9).Value
    GoTo suite1
    End If
    End If
    Next j
    suite1:

    'affichage des resultats 3.2

    Worksheets(nom_tourelle).Cells(N, 4).Value = designation
    Worksheets(nom_tourelle).Cells(N, 9).Value = Ordre
    Worksheets(nom_tourelle).Cells(N, 6).Value = Num_outil
    Worksheets(nom_tourelle).Cells(N, 7).Value = tourelle
    Worksheets(nom_tourelle).Cells(N, 8).Value = famille
    Worksheets(nom_tourelle).Cells(N, 5).Value = Orientation
    Worksheets(nom_tourelle).Cells(N, 10).Value = Angle_Tourelle
    Worksheets(nom_tourelle).Cells(N, 11).Value = Rayon_Tourelle
    Worksheets(nom_tourelle).Cells(N, 12).Value = OTX
    Worksheets(nom_tourelle).Cells(N, 13).Value = OTY
    Worksheets(nom_tourelle).Cells(N, 14).Value = Auto_Index

    'info ActCut3.7
    For x = 1 To Dernligne1
    If Worksheets("King-37").Cells(x, 1).Value = critere Then
    If Worksheets("King-37").Cells(x, 3).Value = Num_outil Then
    designation3_7 = Worksheets("King-37").Cells(x, 2).Value
    Orientation3_7 = Worksheets("King-37").Cells(x, 4).Value
    famille = Worksheets("Tourelle Physique VIPROS KING").Cells(N, 4).Value
    GoTo suite2
    End If
    End If
    Next x
    suite2:

    'affichage des resultats 3.7
    With Worksheets(nom_tourelle)
    .Cells(N, 2).Value = designation3_7
    .Cells(N, 3).Value = Orientation3_7
    .Cells(N, 8).Value = famille
    End With
    ' INSERER LA BARRE DE PROGRESSION ICI
    Next N
    Unload U_ProBarre
    End Sub

    A+

    Maurice
    0
  7. anesr Messages postés 27 Statut Membre
     
    Bonjour Maurice,
    Ton code affiche bien la barre de progression mais celle ci n'evolue pas avec le deroulement de ma macro...
    La progression ne marche pas... :(
    0
  8. foo
     
    bonjour

    donne au moins ton fichier pour voir car la je ses pas
    A+
    Maurice
    0
    1. anesr Messages postés 27 Statut Membre
       
      http://cjoint.com/data/0Ckpusk4Tsf.htm

      Bonjour Maurice
      Voila mon fichier Maurice...
      Quand tu clique sur le bouton importer je voudrai qu'une barre de progression informe l'utilisateur du déroulement de la macro.
      Rq: dans mon fichier la macro s'exécute rapidement car ce document et loin d'être complet.

      Si tu a une solution se serai sympa de me venir en aide.
      Merci Maurice
      0
  9. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    Bonjour,

    plutôt que de boucler sur toutes les lignes pour rechercher ton critère, regarde directement s'il est présent en colonne A avec .find.
    Et ajoute au début Application.ScreenUpdating = False
    Tout accélèrera ton code et la barre de progression sera peut-être inutile.
    Je n'ai pas pu tester, je ne sais pas comment faire marcher ton classeur.
    ex : 
    Sub recherche(nom_tourelle As String)
    Application.ScreenUpdating = False
    dernligne = Worksheets("donnees king").Range("A65536").End(xlUp).Row
    critere = Worksheets(nom_tourelle).Name
    Worksheets(nom_tourelle).Cells(9, 4).Value = "designation(3.2)"
    Worksheets(nom_tourelle).Cells(9, 9).Value = "Orientation"
    Worksheets(nom_tourelle).Cells(9, 6).Value = "poste"
    Worksheets(nom_tourelle).Cells(9, 7).Value = "Tourelle"
    Worksheets(nom_tourelle).Cells(9, 8).Value = "famille"
    Worksheets(nom_tourelle).Cells(9, 5).Value = "Ordre"
    Worksheets(nom_tourelle).Cells(9, 10).Value = "Angle Tourelle"
    Worksheets(nom_tourelle).Cells(9, 11).Value = "Rayon Tourelle"
    Worksheets(nom_tourelle).Cells(9, 12).Value = "OTX"
    Worksheets(nom_tourelle).Cells(9, 13).Value = "OTY"
    Worksheets(nom_tourelle).Cells(9, 14).Value = "Auto Index"

    For n = 10 To 67
        Num_outil = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 2).Value
        Ordre = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 1).Value
        Taille = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 3).Value
        Angle_Tourelle = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 5).Value
        Rayon_Tourelle = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 6).Value
        OTX = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 7).Value
        OTY = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 8).Value
        Auto_Index = Worksheets("Tourelle Tout VIPROS KING").Cells(n, 9).Value

        designation = "--"
        Orientation = "--"
        Tourelle = "--"
        famille = "--"
        Set c = Worksheets("donnees king").Columns(1).Find(critere, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            Worksheets(nom_tourelle).Cells(n, 4).Value = designation
            Worksheets(nom_tourelle).Cells(n, 5).Value = Ordre
            Worksheets(nom_tourelle).Cells(n, 6).Value = Num_outil
            Worksheets(nom_tourelle).Cells(n, 7).Value = Tourelle
            Worksheets(nom_tourelle).Cells(n, 8).Value = famille
            Worksheets(nom_tourelle).Cells(n, 9).Value = Orientation
            Worksheets(nom_tourelle).Cells(n, 10).Value = Angle_Tourelle
            Worksheets(nom_tourelle).Cells(n, 11).Value = Rayon_Tourelle
            Worksheets(nom_tourelle).Cells(n, 12).Value = OTX
            Worksheets(nom_tourelle).Cells(n, 13).Value = OTY
            Worksheets(nom_tourelle).Cells(n, 14).Value = Auto_Index
        Else
            MsgBox "Erreur : critère " & critère & " non trouvé."
        End If
    Next n
End Sub

    J'ai pris en exemple la feuille vipros_king

    eric
    0
  10. foo
     
    Bonjour

    Voila voir le Module M_Modif

    http://cjoint.com/?3CkqSV7QycP

    A+
    Maurice
    0
    1. anesr Messages postés 27 Statut Membre
       
      Merci Maurice
      J'ai adapté ton fichier et sa fonctionne parfaitement...
      Merci encore
      0
  11. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
     
    Bonjour,

    et ma réponse du 8 mars 2014 à 19:30, tu n'en as rien à f... ?
    Ok, j'éviterai tes questions à l'avenir

    eric
    0
    1. anesr Messages postés 27 Statut Membre
       
      Il ne faut pas réagir comme ça eriiic ' ton aide m'a été bien précieuse crois moi et je t'en suis très reconnaissant.D'ailleurs ton outils de recherche d'onglet a immediatment intégrer mon travail.le document que j'ai mis sur le forum n'est pas mon travail final mais juste un appercu ...j'ai fais cela car je ne veut pas mettre sut la toile mon projet qui est rattaché a une entreprise ...
      J'espère que tu pourra comprendre eriiic
      0
    2. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Oui, et bien la moindre des politesses est de répondre aux interventions de ceux qui prennent du temps pour toi.
      Ca n'est pas évident pour tout le monde apparemment.
      Et je te parle de ce fil là, pas du précédent.
      eric
      0
      1. anesr Messages postés 27 Statut Membre > eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention  
         
        Je suis DSL eriiic ' j'ai commis une erreur' je le reconnais et je m'en excuse.
        Ceci dit ' tu pourrai te montrer un peu plud réceptif tout de même. Tu crois pas?
        0
    3. eriiic Messages postés 24581 Date d'inscription   Statut Contributeur Dernière intervention   7 281
       
      Réceptif, c'est peut-être à toi de l'être.
      Toujours aucun retour sur ma proposition d'accélérer ton programme et de voir ensuite si une barre de progression est toujours nécessaire.
      Tu n'as même pas testé le code proposé, je parle dans le vent et j'ai bossé pour rien.

      eric
      0
    4. anesr Messages postés 27 Statut Membre
       
      afin de répondre a ton message je tiens a te signaler que j'ai penser a utiliser la fonction Application.ScreenUpdating = False comme tu me le propose dans ton message du 8 mars. Je comprend que tu me fasse une remarque dans la mesure ou je ne t'ai pas tenu informé et que tu prends de ton temps pour me venir en aide (d'ailleurs je t'ai présenté mes excuses) mais je veux pas qu'on s'éternise la dessus.

      Voila la preuve que j'ai bien utilisé la fonction Application.ScreenUpdating = False

      Sub creerFeuilles()

      'suppression preliminaire avant creation des onglets
      Application.ScreenUpdating = False

      Dim curWsht As Worksheet
      Application.DisplayAlerts = False
      For Each curWsht In ThisWorkbook.Sheets
      If curWsht.Name <> "Paramétrage" And curWsht.Name <> "Vipros_King" ............
      0

Discussions similaires

Au sujet du S majuscule avec trait oblique barré
charlene -
Pierr10 -

6 réponses
O barré horizontalement
JCB40 -
JCB40 -

3 réponses
Comment faire le signe = barré?
rma71 -
gillette83 -

5 réponses
Alt + = un égal barré = différence !
KAPAZZA -
benj -

7 réponses
Barre verticale droite sur clavier
k_lou -
Leuide -

41 réponses