Optimiser un code

**eliot.raymond** · 18/10/2012, 13h24

Bonjour a toutes et tous, Forum

Je souhaiterai svp optimiser un code voir ci-dessous car je rencontre des lenteurs de chargement du programme de ma gestion vidéo.

Je ne vois pas comment faire autrement que de répèter 27 fois le code Label 100 à 126

Merci a vous pour votre temps et merci d'avoir lu ma demande, bonne journée

PS: le programme fonctionne très bien juste un peu long a se charger.
PS: mis juste procédures pour exemple sinon ça fait 567 lignes de code

Cordialement Ray

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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
 
'* LES 27 PROCEDURES SUIVANTES PERMETTENT DE DETECTER QUAND LA SOURIS SURVOLE LE LABEL
'* EN CAS DE SURVOL, LA CASE DEVIENT ROUGE ET LA CASE EN-DESSOUS DEVIENT JAUNE
Private Sub Label100_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  For i = 100 To 126
    With Me
      If .Controls("Label" & i).Name = "Label100" Then
        .Controls("Label" & i).BackColor = RGB(255, 0, 0)    'Rouge
        .Controls("Label" & i + 27).BackColor = &HFFFF80     'Turquoise
        If .Controls("Label" & i + 27).Caption <> "" Then
          Gestion_du_listing.TextBox3.Value = .Controls("Label" & i).Caption & " : " & .Controls("Label" & i + 27).Caption
        Else
          Gestion_du_listing.TextBox3.Value = ""
        End If
      Else
        If .Controls("Label" & i).BackColor <> &H800080 And _
           .Controls("Label" & i + 27).BackColor <> &HC0C0FF Then
          .Controls("Label" & i).BackColor = &H800080          'Violet
          .Controls("Label" & i + 27).BackColor = &HC0C0FF     'Rose
        End If
      End If
    End With
  Next i
End Sub
 
Private Sub Label101_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  For i = 100 To 126
    With Me
      If .Controls("Label" & i).Name = "Label101" Then
        .Controls("Label" & i).BackColor = RGB(255, 0, 0)
        .Controls("Label" & i + 27).BackColor = &HFFFF80
        If .Controls("Label" & i + 27).Caption <> "" Then
          Gestion_du_listing.TextBox3.Value = .Controls("Label" & i).Caption & " : " & .Controls("Label" & i + 27).Caption
        Else
          Gestion_du_listing.TextBox3.Value = ""
        End If
      Else
        If .Controls("Label" & i).BackColor <> &H800080 And _
           .Controls("Label" & i + 27).BackColor <> &HC0C0FF Then
          .Controls("Label" & i).BackColor = &H800080
          .Controls("Label" & i + 27).BackColor = &HC0C0FF
        End If
      End If
    End With
  Next i
End Sub
 
Private Sub Label102_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  For i = 100 To 126
    With Me
      If .Controls("Label" & i).Name = "Label102" Then
        .Controls("Label" & i).BackColor = RGB(255, 0, 0)
        .Controls("Label" & i + 27).BackColor = &HFFFF80
        If .Controls("Label" & i + 27).Caption <> "" Then
          Gestion_du_listing.TextBox3.Value = .Controls("Label" & i).Caption & " : " & .Controls("Label" & i + 27).Caption
        Else
          Gestion_du_listing.TextBox3.Value = ""
        End If
      Else
        If .Controls("Label" & i).BackColor <> &H800080 And _
           .Controls("Label" & i + 27).BackColor <> &HC0C0FF Then
          .Controls("Label" & i).BackColor = &H800080
          .Controls("Label" & i + 27).BackColor = &HC0C0FF
        End If
      End If
    End With
  Next i
End Sub
 
Private Sub Label103_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  For i = 100 To 126
    With Me
      If .Controls("Label" & i).Name = "Label103" Then
        .Controls("Label" & i).BackColor = RGB(255, 0, 0)
        .Controls("Label" & i + 27).BackColor = &HFFFF80
        If .Controls("Label" & i + 27).Caption <> "" Then
          Gestion_du_listing.TextBox3.Value = .Controls("Label" & i).Caption & " : " & .Controls("Label" & i + 27).Caption
        Else
          Gestion_du_listing.TextBox3.Value = ""
        End If
      Else
        If .Controls("Label" & i).BackColor <> &H800080 And _
           .Controls("Label" & i + 27).BackColor <> &HC0C0FF Then
          .Controls("Label" & i).BackColor = &H800080
          .Controls("Label" & i + 27).BackColor = &HC0C0FF
        End If
      End If
    End With
  Next i
End Sub

**Didier Gonard** · 18/10/2012, 13h52

Bonjour,

fais des recherches sur les modules de classe dans les tutos ou fils DVP

genre :http://www.developpez.net/forums/d96...urs-controles/

cordialement,

Didier

**eliot.raymond** · 18/10/2012, 14h10

Salut Ormonth, forum

Merci de réponse, j'ai effectivement penser aux modules de classe

mais après avoir lu et essayer déja plusieurs fois, c'est trop compliqué pour moi

pas suffisament bon en VBA pour mettre en application.

Merci tout de mème d'avoir pris le temps de me lire, mais je ne saurai pas faire

qui de plus une bonne partie du code n'ai pas de moi

juste planter le décor et eu l'idée de faire cette gestion

Encore merci, c'est pas grave perdu défi

Bye Bye et bonne journée a toi

Cordialement Raymond

**eliot.raymond** · 19/10/2012, 08h58

Bonjour a toutes te tous, forum

Malgré maintes essais hier je ne suis pas parvenu a faire comme conseillé
en réponse a ma demande

bon bath tant pis, avoir essayer au moins.

bonne journée

Cdlt

**kiki29** · 19/10/2012, 10h20

Salut, un exemple basique

Dans un module standard

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Option Explicit
 
Sub Bouton1_QuandClic()
    UserForm1.Show
End Sub

Dans un module de classe baptisé clsUsfLabels

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Option Explicit
 
Public WithEvents LabelX As msforms.Label
 
Private Sub LabelX_Click()
    MsgBox LabelX.Name & " cliqué : Tag : " & LabelX.Tag
End Sub
 
Private Sub LabelX_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)
    ' Code
End Sub

Dans module UserForm

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
Option Explicit
 
Dim mesLabels() As clsUsfLabels
 
Private Sub UserForm_Initialize()
Dim Ctrl As Object, i As Long
    ReDim mesLabels(1 To Me.Controls.Count)
    For Each Ctrl In Me.Controls
        If TypeName(Ctrl) = "Label" Then
            i = i + 1
            Set mesLabels(i) = New clsUsfLabels
            Set mesLabels(i).LabelX = Ctrl
            Ctrl.Tag = i
        End If
    Next Ctrl
    ReDim Preserve mesLabels(1 To i)
End Sub

**eliot.raymond** · 19/10/2012, 13h47

Salut kiki29, forum

Merci beaucoup de ta réponse, j'imprime et je mets en application dès que possible pour l'instant boulot, je dirai si j'ai réussi

Encore merci bon W-end a toi et a tous d'ailleurs hiihi

Cordialement Raymond

**eliot.raymond** · 19/10/2012, 17h39

Salut kiki29, forum

Voila j'ai suivi tes conseils a la lettre,

Tes explications très claires ont fait que j'ai réussi a faire fonctionner de nouveau mon programme avec a la clé gain de temps diviser par deux.

Très bien le module de classe

Que te dire merci beaucoup de ton aide

je te souhaite un exellent W-end ainsi qu'une bonne soirée et

Bye bye Bien cordialement Raymond

Optimiser un code [XL-2007]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager