Insertion barre de progression
Résolu/Fermé
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
-
28 févr. 2014 à 15:26
anesr Messages postés 22 Date d'inscription mercredi 26 février 2014 Statut Membre Dernière intervention 10 novembre 2016 - 11 mars 2014 à 11:09
anesr Messages postés 22 Date d'inscription mercredi 26 février 2014 Statut Membre Dernière intervention 10 novembre 2016 - 11 mars 2014 à 11:09
A voir également:
- Insertion barre de progression
- Insertion liste déroulante excel - Guide
- Windows 11 barre des taches a gauche - Guide
- Insertion sommaire word - Guide
- Barre verticale mac - Forum MacOS
- Barré whatsapp - Guide
10 réponses
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
28 févr. 2014 à 18:17
28 févr. 2014 à 18:17
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. -_-
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. -_-
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
6 mars 2014 à 16:13
6 mars 2014 à 16:13
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.
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.
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
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
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
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
8 mars 2014 à 16:36
8 mars 2014 à 16:36
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... :(
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... :(
bonjour
donne au moins ton fichier pour voir car la je ses pas
A+
Maurice
donne au moins ton fichier pour voir car la je ses pas
A+
Maurice
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
Modifié par anesr le 10/03/2014 à 15:24
Modifié par anesr le 10/03/2014 à 15:24
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
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
eriiic
Messages postés
24600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2024
7 239
8 mars 2014 à 19:30
8 mars 2014 à 19:30
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 :
J'ai pris en exemple la feuille vipros_king
eric
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
Bonjour
Voila voir le Module M_Modif
http://cjoint.com/?3CkqSV7QycP
A+
Maurice
Voila voir le Module M_Modif
http://cjoint.com/?3CkqSV7QycP
A+
Maurice
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
11 mars 2014 à 11:09
11 mars 2014 à 11:09
Merci Maurice
J'ai adapté ton fichier et sa fonctionne parfaitement...
Merci encore
J'ai adapté ton fichier et sa fonctionne parfaitement...
Merci encore
eriiic
Messages postés
24600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2024
7 239
10 mars 2014 à 19:02
10 mars 2014 à 19:02
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
et ma réponse du 8 mars 2014 à 19:30, tu n'en as rien à f... ?
Ok, j'éviterai tes questions à l'avenir
eric
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
10 mars 2014 à 19:20
10 mars 2014 à 19:20
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
J'espère que tu pourra comprendre eriiic
eriiic
Messages postés
24600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2024
7 239
10 mars 2014 à 23:11
10 mars 2014 à 23:11
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
Ca n'est pas évident pour tout le monde apparemment.
Et je te parle de ce fil là, pas du précédent.
eric
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
>
eriiic
Messages postés
24600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2024
10 mars 2014 à 23:53
10 mars 2014 à 23:53
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?
Ceci dit ' tu pourrai te montrer un peu plud réceptif tout de même. Tu crois pas?
eriiic
Messages postés
24600
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
21 octobre 2024
7 239
11 mars 2014 à 10:51
11 mars 2014 à 10:51
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
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
anesr
Messages postés
22
Date d'inscription
mercredi 26 février 2014
Statut
Membre
Dernière intervention
10 novembre 2016
11 mars 2014 à 11:08
11 mars 2014 à 11:08
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" ............
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" ............