Simplification de code

**corinthien** · 05/02/2019, 16h55

Bonjour le forum, existe-t'il un moyen de simplifier ce code qui se répète 27 fois sur les zones de texte (avec des noms différents) du formulaire ?

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
Private Sub Fax_GotFocus()
    Me.TimerInterval = 700
    With Me.Fax_Étiquette
        .SpecialEffect = 2
        .BackColor = vbRed
        .ForeColor = vbWhite
    End With
    Set Etiquette = Me.Fax_Étiquette
    Cont = Me.Fax.Name
 
    ' Vérification Internet
    VerifInternet
End Sub
 
Private Sub Fax_LostFocus()
    Me.TimerInterval = 0
    With Me.Fax_Étiquette
        .SpecialEffect = 1
        .BackColor = RGB(204, 200, 194)
        .ForeColor = vbBlack
    End With
End Sub

et l'action sur le Timer du formulaire

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
Private Sub Form_Timer()
    If Me.Etiquette.ForeColor = vbBlack Then
        With Me.Etiquette
            .SpecialEffect = 2
            .BackColor = vbRed
            .ForeColor = vbWhite
        End With
    Else
        With Me.Etiquette
            .SpecialEffect = 1
            .BackColor = RGB(204, 200, 194)
            .ForeColor = vbBlack
        End With
    End If
End Sub

Merci de votre aide.

**mercatog** · 05/02/2019, 17h10

Bonjour

Regarde du côté des modules de classe.

**corinthien** · 05/02/2019, 17h21

Merci mercatog, j'y pensais mais je ne sais pas comment faire…

**Philippe Tulliez** · 05/02/2019, 19h38

Bonjour,

j'y pensais mais je ne sais pas comment faire…

Un peu de lecture sur le sujet

**corinthien** · 05/02/2019, 19h45

Merci Philippe, je vais voir ça.

**patricktoulon** · 05/02/2019, 19h59

bonsoir

désolé de t'arréter dans ton élan mais si tes fax... sont des textboxs les modules classe ne gerent pas les evenement focus

Nom : demo2.gif
Affichages : 226
Taille : 373,5 Ko

Nom : demo2.gif
Affichages : 226
Taille : 373,5 Ko

**corinthien** · 05/02/2019, 20h19

Bonsoir Patrick, pas de solution alors ?

**patricktoulon** · 05/02/2019, 21h06

ben faudrait deja savoir quel type de control a cet evenement dispo chez moi les textboxs et compagnie ne l'ont pas

parlerais tu de l'evenement exit par hasard ????
regarde comment je gere 3 evenement exit en une sub

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
option explicit
Dim act As Boolean
 
Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean): lostfocus TextBox1: End Sub
Private Sub TextBox2_Exit(ByVal Cancel As MSForms.ReturnBoolean): lostfocus TextBox2: End Sub
Private Sub TextBox3_Exit(ByVal Cancel As MSForms.ReturnBoolean): lostfocus TextBox3: End Sub
 '
Private Sub UserForm_Activate(): act = True: End Sub
'
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer):    act = False: End Sub
'
Private Sub lostfocus(ctrl)
    If act = True Then
    With ctrl
        Select Case True
        Case .Value < 10: .BackColor = vbRed
        Case .Value > 10 And .Value < 20: .BackColor = vbGreen
        Case .Value < 30 And .Value > 20: .BackColor = vbMagenta
        End Select
    End With
End If
End Sub

**corinthien** · 05/02/2019, 21h17

tant qu'à faire, si on peut remplacer GotFocus par Enter et LostFocus par Exit, ça me convient

**patricktoulon** · 05/02/2019, 21h26

je sais pas il va faloir que je test

le enter se declanche quand tu entre dans le textbox avec la souris
je sais pas si quand tu change la valeur par vba il se declanche a tester
cela dit ce que je t'ai donné en exemple peut parfaitement etre classé le resultat sera le meme

**corinthien** · 05/02/2019, 21h58

dis-moi, ce code, je le mets ou?

je n'ai pas l'habitude des modules de classe

**patricktoulon** · 05/02/2019, 22h04

re
c'est pas un module classe c'est juste les meme eveement qui vont vers une seule sub dans le userform

**corinthien** · 05/02/2019, 22h13

voila, j'ai droit à une erreur :

L'expression Sur sortie entrée comme paramètre de la propriété de type événement est à l'origine d'une erreur. La déclaration de la procédure ne correspond pas à la description de l'événement ou de la procédure de même nom.

* Le résultat de l'expression n'est pas le nom d'une macro, le nom d'une fonction définie par l'utilisateur ou [Event Procedure].
* Une erreur a peut-être été commise lors de l'évaluation d'une fonction, d'un événement ou d'une macro.
&Afficher l'aide >>

502473

**corinthien** · 06/02/2019, 00h16

J'ai expérimenter ceci sur GotFocus et LostFocus de touts les TextBox (toutes les étiquette associées aux TextBox portent comme nom le "NomDuTextBox_Étiquette")

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
Private Sub Adresse_1_GotFocus()
    TexteGotFocus
    '    Me.TimerInterval = 700
    '    With Me.Adresse_1_Étiquette
    '        .SpecialEffect = 2
    '        .BackColor = vbRed
    '        .ForeColor = vbWhite
    '    End With
    '    Set Etiquette = Me.Adresse_1_Étiquette
    '    Cont = Me.Adresse_1.Name
 
    '    ' Vérification Internet
    '    VerifInternet
End Sub
 
Private Sub Adresse_1_LostFocus()
    TexteLostFocus
    '    Me.TimerInterval = 0
    '    With Me.Adresse_1_Étiquette
    '        .SpecialEffect = 1
    '        .BackColor = RGB(204, 200, 194)
    '        .ForeColor = vbBlack
    '    End With
End Sub

et le code commun à touts les TextBox

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
Private Sub TexteGotFocus()
    Dim eti As Label
    Set eti = Me.Controls(Me.ActiveControl.Name & "_Étiquette")
    Me.TimerInterval = 700
    With eti
        .SpecialEffect = 2
        .BackColor = vbRed
        .ForeColor = vbWhite
    End With
    Set Etiquette = eti
    Cont = Me.ActiveControl.Name
    Set eti = Nothing
 
    ' Vérification Internet
    VerifInternet
End Sub
 
Private Sub TexteLostFocus()
    Me.TimerInterval = 0
    Dim eti As Label
    Set eti = Me.Controls(Me.ActiveControl.Name & "_Étiquette")
    With eti
        .SpecialEffect = 1
        .BackColor = RGB(204, 200, 194)
        .ForeColor = vbBlack
    End With
    Set eti = Nothing
End Sub

Merci à vous tous. J'ai pu éliminer 436 lignes.

**patricktoulon** · 06/02/2019, 04h11

je viens a peine de realioser que tu parlais de controls sur un sheets
comme tu parlais de formulaire je pensait que tu parlais d'userform
c'est different
bref tu a opté pour la fonction commune

**corinthien** · 06/02/2019, 12h26

Bonjour Patrick, c'est bien sur un formulaire et ça fonctionne comme je le voulais. Merci encore, vous m'avez mis sur la voie. Ça sert uniquement à faire clignoter le label associé au TextBox.

**patricktoulon** · 06/02/2019, 13h21

que les choses soient claires quand tu dis formulaire tu parle bien d'userform ??

si oui tu a un excel que personne n'a

car les evenement gotfocus et lostfocus pour quelque controls que se soit dans un userform n'existent pas

il faudrait savoir de quoi on parle la userform ou feuille de calcul(sheets)

une feuille n'est pas un formulaire

**corinthien** · 06/02/2019, 13h49

Ne nous énervons pas, ce sont bien des formulaires, mais j'ai mer** pour le forum, ce sont des Form Access. Désolé mais vous m'avez mis sur les rails, et j'ai trouvé ma solution. Mes excuses pour votre temps perdu.

Simplification de code

Macros et VBA Excel

Discussions similaires

Partager

Partager