fichier test de la macro

[TYPX]

Sub CYCLECONTROLE2()

If Sheets('CONTROLE2').Range('W1').Value = ('DETERS_1/1') Then
Sheets('CONTROLE2').Select
Range('A1:AO1').Select

Selection.Cut

Sheets('CONTROLE2').Select
L = Sheets('CONTROLE2').Range('A150').End(xlUp).ROW + 1
Sheets('CONTROLE2').Range('A' & L).Select
ActiveSheet.Paste
Sheets('CONTROLE2').Select
Range('A1').Select

Sheets('CONTROLE2').Rows(ListIndex + 1).Delete


Call CYCLECONTROLE2
Else: Sheets('CONTROLE2').Select
If Sheets('CONTROLE2').Range('A1').Value = Sheets('CONTROLE2').Range('A2').Value Then 'NOM
Else: MsgBox 'NOM '
Call ERREUR2
Exit Sub
End If

If Sheets('CONTROLE2').Range('B1').Value = Sheets('CONTROLE2').Range('B2').Value Then 'PRENOM
Else: MsgBox 'ERREUR DATE DE NAISSANCE '
Call ERREUR2
Exit Sub
End If


If Sheets('CONTROLE2').Range('D1').Value = Sheets('CONTROLE2').Range('D2').Value Then 'DATE DE NAISSANCE
Else: MsgBox 'ERREUR DATE DE NAISSANCE '
Call ERREUR2
Exit Sub
End If



If Sheets('CONTROLE2').Range('N1').Value = Sheets('CONTROLE2').Range('N2').Value Then 'GROUPE
Else: MsgBox 'ERREUR GROUPE '
Call ERREUR2
Exit Sub
End If

If Sheets('CONTROLE2').Range('O1').Value = Sheets('CONTROLE2').Range('O2').Value Then 'D
Else: MsgBox 'ERREUR D '
Call ERREUR2
Exit Sub
End If

If Sheets('CONTROLE2').Range('R1').Value = Sheets('CONTROLE2').Range('R2').Value Then 'PHENOTYPE
Else: MsgBox 'ERREUR PHENOTYPE '
Call ERREUR2
Exit Sub
End If

If Sheets('CONTROLE2').Range('P1').Value = Sheets('CONTROLE2').Range('P2').Value Then 'KELL
Else: MsgBox 'ERREUR KELL '
Call ERREUR2
Exit Sub
End If


Sheets('CONTROLE2').Select
Range('A1:AO2').Select

Selection.Cut

Sheets('CONTROLE2').Select
L = Sheets('CONTROLE2').Range('A150').End(xlUp).ROW + 1
Sheets('CONTROLE2').Range('A' & L).Select
ActiveSheet.Paste
Sheets('CONTROLE2').Select
Range('A1').Select

Sheets('CONTROLE2').Rows(ListIndex + 1).Delete
Sheets('CONTROLE2').Rows(ListIndex + 1).Delete

If Sheets('CONTROLE2').Range('AO1').Value = ('S') Then
Dim TEMP As String
TEMP = MsgBox('CONTRÔLE DETERMINATIONS OK', vbOKOnly + vbDefaultButton1 + vbInformation, 'CONTROLE OK')
TEMP = MsgBox('VOULEZ VOUS LANCER L'EDITION', vbYesNo + vbDefaultButton1 + vbExclamation, 'EDITIONS DES CARTES')
If TEMP = vbYes Then
MultiPage1.Value = 0
Call EDITION
Else: MultiPage1.Value = 0
Exit Sub
End If

Exit Sub
Else: Call CYCLECONTROLE2
End If


End If










End Sub

 

[Marc_du_78]

Bonsoir TYPX,
Essaie ceci apres la ligne sub

Application.ScreenUpdating = False

et avant End Sub

Application.ScreenUpdating = True
Bon courage, je ne suis pas un spécialiste loin s'en faut, mais ceci accélère le traitement

 

[TYPX]

Bonsoir Marc

Effectivement le fait que l'écran ne soit pas activé pendant la macro, accélère celle ci.
Sans chercher la lune c'est déjà très bien.
Mille Merci Marc et très bonne soirée

 

[jp14]

Bonsoir

Un exemple de modification du temps d'éxécution d'une macro

Lien supprimé

Dans un premier définir toutes les variables utlisées dans le programme.
Mettre en haut du modue
Option Explicit
puis débogage
compiler
la machine va indiquer les variables qui ne sont pas déclarées
Dim L As Long, ListIndex As Long
................................

Message édité par: jp14, à: 28/02/2006 17:36

Message édité par: jp14, à: 28/02/2006 17:45

 

[Marc_du_78]

Ce n'est pas moi qu'il faut remercier, mais ce Forum, car j'ai glané cette info comme bien d'autre ici.
Loin d'être spécialiste, il me semble que ton code devrait être retravaillé comme tes appels à

Sheets('CONTROLE2').Select
Range('A1:AO1').Select
Selection.Cut
Sheets('CONTROLE2').Select

Il me semble sauf grossière erreur de ma part que tu es tjrs dans ('CONTROLE2').
Aussi pourquoi la sélectionner une deuxième fois
Bonne soirée et bon courage.

 

[TYPX]

Tout à fait exact
Je dépoussière et j'essaye
Merci
typx :whistle:

 

[Dan]

Bonsoir,

Typx, voici une début de ta macro à modifier

Sub CYCLECONTROLE2()
Application.ScreenUpdating = False
With Sheets('CONTROLE2')
If .Range('W1').Value = ('DETERS_1/1') Then
Range('A1:AO1').Cut
L = .Range('A150').End(xlUp).Row + 1
    .Range('A' & L).Select
ActiveSheet.Paste
    .Range('A1').Select
    .Rows(ListIndex + 1).Delete
End If
'...le reste de ta macro...
End With
Application.ScreenUpdating = True
End Sub

Il y a encore pas mal de chose derrière à changer.

Je reviens plus tard.

 

[Marc_du_78]

Regarde ceci s'il n'y a pas un truc
Exit Sub
End If
Exit Sub
Else: Call CYCLECONTROLE2
Tu relance ta macro

 

[TYPX]

Tout à fait exact
Je dépoussière et j'essaye
Merci
typx :whistle:

 

[TYPX]

Effectivement je boucle la macro et je controle tant que je ne suis pas arrivé sur une ligne avec AO='S'
je le fais dans une première macro et c'est ok
typx

 

[Jam]

Salut TYPX, Marc, Dan,

Juste une petite précision histoire d'alléger ton code.
Lorsque tu as sélectionné une feuille, tu n'as plus besoin d'y faire référence. Tu le fais une fois en début de code (histoire d'être sur d'y être) et ensuite tu jongles avec les Ranges sans avoir à re Selectionner la feuille.
Par exemple

Feuil1.select
Range('A2')=10
Range('toto')='l'histoire de toto'

Précision: si tu peux éviter des Select dans ton code celui-ci ne s'en comportera que mieux et il ira beaucoup plus vite.

Bon courage

 

[Jam]

Re à tous,

A la relecture de ton code, j'ai vu que tu faisais bon nombre de test d'erreur. Tu peux modifier ton code en utilisant la gestion des erreurs (On Error Goto) et déclarer tes types d'erreurs à toi dans des constantes:

'en entête de module
Const ERR_PHENOTYPE As Long = 51000
Const ERR_D As Long = 51001
'etc...

Ensuite dans ta procédure tu y mets:

On Error Goto GestionErreur
'(le début de ton code)
If Range('N1')=Range('N2') Then Error(ERR_PHENOTYPE)
If Range('O1')=Range('O2) Then Error(ERR_D)
'(...ton code)
GestionErreur:
Select Case Err.Number
   Case ERR_PHENOTYPE
      MsgBox 'ERREUR PHENOTYPE'
   Case ERR_D
      MsgBox 'ERREUR D'
End Select
Err.Clear
Call ERREUR2
End Sub

Tu noteras au passage que cela simplifie la gestion des Exit Sub, Else...

Bon courage