Sujet Précédent Sujet Suivant

Optimiser un bout de code

dudulleray -  
 dudulleray -
Bonjour a toutes et tous, forum bonjour



Je souhaiterai svp alléger un peu le code ci-dessous, j'ai essayer de placer un autre WITH afin d'éviter le répétitif mais sans succès.

PS: le code provient du module classe lui mème.

Merci a vous et de votre temps, bonne journée et bonnes vacances a tous

Cdlt Ray 

Public WithEvents Bouton As MSForms.CheckBox         ' Variable des 14 CheckBoxs

'************************* VALIDER PRELEVEMENTS MENSUELS + LABELS (1 à 168)
Private Sub Bouton_Click()
Dim Colonne, Ligne, NumLabel As Integer

  Ligne = Val(Mid(Bouton.Name, 9))
  Colonne = Month(Date) - 1
  NumLabel = Ligne + (Colonne * 14)


  With Sheets("Compte")
    If Bouton.Value = True Then
      If .Cells(Ligne, "B") <> "" Then                                                 ' Quelque chose d'inscrit en colonne B
        UserForm1.Controls("Label" & 399 + Ligne).Caption = WorksheetFunction.Proper(Format(.Cells(Ligne, "B"), "Dddd dd Mmmm yyyy"))
    Else
        UserForm1.Controls("Label" & 399 + Ligne).Caption = WorksheetFunction.Proper(Format(Date, "Dddd dd Mmmm yyyy"))
      End If
      If Val(Ws.Cells(Ligne + 1, 5 + Colonne)) <> 0 Then
        UserForm1.Controls("Checkbox" & 1 + Ligne - 1).BackColor = &H808080
        
        UserForm1.Controls("Label" & 399 + Ligne).BackColor = &H808080                 ' Backcolor Gris fonçé "Prélèvements"
        UserForm1.Controls("Label" & 399 + Ligne).ForeColor = vbBlue                   ' Ecriture en Bleu "Prélèvements"
        UserForm1.Controls("Label" & NumLabel).BackColor = &H808080                ' Backcolor Gris fonçé "Labels mois"
        Ws.Cells(Ligne + 1, 5 + Colonne).Interior.ColorIndex = 16                  ' Fond Gris cellule feuil1(Compte)
    Else
        UserForm1.Controls("Label" & 399 + Ligne).Caption = ""
      End If
    Else
       UserForm1.Controls("Checkbox" & 1 + Ligne - 1).BackColor = vbBlue
       UserForm1.Controls("Label" & 399 + Ligne).Caption = ""
       UserForm1.Controls("Label" & 399 + Ligne).BackColor = vbBlue                ' Backcolor Bleu Fond "Prélèvements"
       UserForm1.Controls("Label" & NumLabel).BackColor = vbBlue                   ' Backcolor Bleu fonçé "Labels mois"
       Ws.Cells(Ligne + 1, 5 + Colonne).Interior.ColorIndex = 4                    ' Fond Vert cellule feuil1(Compte)
    End If
    
    .Cells(Ligne, "A") = IIf(Bouton.Value = True, 1, 0)
    .Cells(Ligne, "B") = UserForm1.Controls("Label" & 399 + Ligne).Caption
    
    UserForm1.Controls("Label" & 181 + Colonne).Caption = IIf(Ws.Cells(17, 5 + Colonne) > 0, Format(Ws.Cells(17, 5 + Colonne), Euro), "") ' Restant dû
    
    UserForm1.Controls("Label" & 217 + Colonne).Caption = Format(Ws.Cells(20, 5 + Colonne), Euro) ' Solde
      If Ws.Cells(20, 5 + Colonne) < 0 Then
         UserForm1.Controls("Label" & 217 + Colonne).ForeColor = &HFF&
      Else
        UserForm1.Controls("Label" & 217 + Colonne).ForeColor = &HFF00&
      End If
      
End With
End Sub
A voir également:

6 réponses

Réponse 1 / 6
climbfly
 
Pour rendre plus lisible, tu pourrais déjà remplacer les noms de controle de la collection UserForm1.Controls pour des variables initialisées en début de fonction, étant donné que ces noms ne dépendent que du n° de ligne qui ne varie pas:

UserForm1.Controls("Label" & 217 + Colonne) -> UserForm1.Controls(Label217)

Pour mieux faire, je pense qu'il est possible en VB de créer une référence d'un objet déjà existant, c'est à dire:
tu as besoin du controle "Label" & 399 + Ligne", tu crée en début de fonction une variable ctrl399=UserForm1.Controls("Label" & 399 + Ligne).

Voilà, ton code sera déjà moins lourd
0
dudulleray
 
Re salut

Bon voila ce que j'ai réussi a faire, si tu peux me dire si c'est OK et voir svp
si possible de faire mieux.

Merci pour ton aide

A plus tard

Ray 

Option Explicit
Public WithEvents Bouton As MSForms.CheckBox         ' Variable des 14 CheckBoxs
Public ULab399, ULab217 As MSForms.Label

'************************* VALIDER PRELEVEMENTS MENSUELS + LABELS (1 à 168)
Private Sub Bouton_Click()
Dim Col, Lig, NumLabel As Integer

Lig = Val(Mid(Bouton.Name, 9))
Col = Month(Date) - 1
NumLabel = Lig + (Col * 14)
Set ULab399 = UserForm1.Controls("Label" & 399 + Lig)
Set ULab217 = UserForm1.Controls("Label" & 217 + Col)

With Sheets("Compte")
  If Bouton.Value = True Then
     If .Cells(Lig, "B") <> "" Then                                                      ' Quelque chose d'inscrit en colonne B
         ULab399.Caption = WorksheetFunction.Proper(Format(.Cells(Lig, "B"), "Dddd dd Mmmm yyyy"))
Else
         ULab399.Caption = WorksheetFunction.Proper(Format(Date, "Dddd dd Mmmm yyyy"))
     End If
    
   If Val(Ws.Cells(Lig + 1, 5 + Col)) <> 0 Then
       UserForm1.Controls("Checkbox" & 1 + Lig - 1).BackColor = &H808080
         ULab399.BackColor = &H808080                                                    ' Backcolor Gris fonçé "Prélèvements"
         ULab399.ForeColor = vbBlue                                                      ' Ecriture en Bleu "Prélèvements"
       UserForm1.Controls("Label" & NumLabel).BackColor = &H808080          ' Backcolor Gris fonçé "Labels mois"
       Ws.Cells(Lig + 1, 5 + Col).Interior.ColorIndex = 16                  ' Fond Gris cellule feuil1(Compte)
Else
         ULab399.Caption = ""
   End If
Else
         UserForm1.Controls("Checkbox" & 1 + Lig - 1).BackColor = vbBlue
         ULab399.Caption = ""
         ULab399.BackColor = vbBlue                                          ' Backcolor Bleu Fond "Prélèvements"
       UserForm1.Controls("Label" & NumLabel).BackColor = vbBlue             ' Backcolor Bleu fonçé "Labels mois"
       Ws.Cells(Lig + 1, 5 + Col).Interior.ColorIndex = 4                    ' Fond Vert cellule feuil1(Compte)
   End If
  
        .Cells(Lig, "A") = IIf(Bouton.Value = True, 1, 0)
        .Cells(Lig, "B") = ULab399.Caption
  
      UserForm1.Controls("Label" & 181 + Col).Caption = IIf(Ws.Cells(17, 5 + Col) > 0, Format(Ws.Cells(17, 5 + Col), Euro), "") ' Restant dû
      
         ULab217.Caption = Format(Ws.Cells(20, 5 + Col), Euro)                                                                  ' Solde
   If Ws.Cells(20, 5 + Col) < 0 Then
         ULab217.ForeColor = vbRed           
Else
         ULab217.ForeColor = vbGreen         
   End If
      
End With
End Sub
0
Réponse 2 / 6
dudulleray
 
Salut climbfly

Merci de ta réponse, c'est sympa a toi.

Bon j'ai fait des essais en suivant tes conseils, mais ça n'a pas l'air de marcher
donc je suis de nouveau a la case départ.

J'ai eu 3 erreurs

(1) Variable non définie, ne sachant quoi mettre, j'ai essayer avec string, intéger etc

(2) Qualificateur incorrect

(3) Incompatbilité de type

Mon fichier est une compta perso quasi terminé juste que je voulais optimiser
un peu quelques parties du code.

Vu l'heure je te souhaite un bon appétit et merci

Cdlt Ray
0
Réponse 3 / 6
climbfly
 
Salut Ray,
voila ce que je te propose. Cette version utilise une fonction formatedate, les références à ws sont supprimmés (je pense que c'est = à sheets(compte)), des affectations par défaut ont été définie plutot que de les faire dans les Else
Tu peux aussi définir 2 nouvelle variable pour les controles "Label" & NumLabel et "Label" & 181 + Col

Option Explicit
Public WithEvents Bouton As MSForms.CheckBox ' Variable des 14 CheckBoxs
Public ULab399, ULab217 As MSForms.Label

'************************* VALIDER PRELEVEMENTS MENSUELS + LABELS (1 à 168)
Private function formatDate(expression As String, format As String)
return WorksheetFunction.Proper(Format((expression , "Dddd dd Mmmm yyyy"))
end function

Private Sub Bouton_Click()
Dim Col, Lig, NumLabel As Integer

Lig = Val(Mid(Bouton.Name, 9))
Col = Month(Date) - 1
NumLabel = Lig + (Col * 14)
Set ULab399 = UserForm1.Controls("Label" & 399 + Lig)
Set ULab217 = UserForm1.Controls("Label" & 217 + Col)

// propriétés par défaut
ULab399.Caption = ""
ULab399.BackColor = vbBlue ' Backcolor Bleu Fond "Prélèvements"
ULab217.ForeColor = vbGreen

With Sheets("Compte")
If Bouton.Value = True Then
.Cells(Lig, "A") = 1
If .Cells(Lig, "B") <> "" Then ' Quelque chose d'inscrit en colonne B
ULab399.Caption = formatDate(.Cells(Lig, "B"))
else
ULab399.Caption = formatDate(Date);
voila If

If Val(.Cells(Lig + 1, 5 + Col)) <> 0 Then
UserForm1.Controls("Checkbox" & 1 + Lig - 1).BackColor = &H808080
ULab399.BackColor = &H808080 ' Backcolor Gris fonçé "Prélèvements"
ULab399.ForeColor = vbBlue ' Ecriture en Bleu "Prélèvements"
UserForm1.Controls("Label" & NumLabel).BackColor = &H808080 ' Backcolor Gris fonçé "Labels mois"
.Cells(Lig + 1, 5 + Col).Interior.ColorIndex = 16 ' Fond Gris cellule feuil1(Compte)
End If
Else
UserForm1.Controls("Checkbox" & 1 + Lig - 1).BackColor = vbBlue
UserForm1.Controls("Label" & NumLabel).BackColor = vbBlue ' Backcolor Bleu fonçé "Labels mois"
.Cells(Lig + 1, 5 + Col).Interior.ColorIndex = 4 ' Fond Vert cellule feuil1(Compte)
End If

.Cells(Lig, "B") = ULab399.Caption

UserForm1.Controls("Label" & 181 + Col).Caption = IIf(.Cells(17, 5 + Col) > 0, Format(.Cells(17, 5 + Col), Euro), "") ' Restant dû

ULab217.Caption = Format(Ws.Cells(20, 5 + Col), Euro) ' Solde
If .Cells(20, 5 + Col) < 0 Then
ULab217.ForeColor = vbRed
End If

End With
End Sub
0
Réponse 4 / 6
michel_m Messages postés 18903 Date d'inscription   Statut Contributeur Dernière intervention   3 318
 
Bonjour,

juste un petit passage pour dire que tes variables sont mal déclarées
(peut ^tre ton erreur 1):

Public ULab399, ULab217 As MSForms.Label

ULab399 est ainsi déclarée "variant" mais est ce valable pour un objet ?
il faut écrire
Public ULab399 As MSForms.Label, ULab217 As MSForms.Label

m^me punition pour colas byte, lig as integer

D'autre part pour la fonction formatdate et a moins que return soit une nouveauté 2010 (VBA) 
Public Function formatDate(expression As String) As String 
formatDate = Application.Proper(format(expression, "Dddd dd Mmmm yyyy")) 
End Function

Cette fonction est placée dans un module
Michel
0

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

Posez votre question
Réponse 5 / 6
dudulleray
 
Bonjour Climbfly, michel_m

Merci beaucoup pour vos réponses, ça marche pas trop bien, j'ai un peu toutes sortes d'erreurs et des lignes en rouge

je suis en VBA avec excel 2007

j'ai imprimer vos réponses je regarde encore cette après midi, pour j'ai la dalle

bon app a vous et encore merci
a plus tard Ray
0
Réponse 6 / 6
dudulleray
 
Re

Pas avancé plus avec le code proposer malgré mes essais 

Public ULab399 As MSForms.Label, ULab217 As MSForms.Label


j'ai modifier le code ci-dessus ça Ok

pas trouver mieux pour le moment

A plus tard

Ray
0

Discussions similaires

Comment enlever le chiffrement de bout en bout sur messenger
abfouz -
Radinoz -

3 réponses
commen faire gestes technique sur ps3
didi -
sasa26200 -

5 réponses