Simplication de code

D

Defcom60

XLDnaute Junior
Bonjour,

Je cherche un moyen de simplifier le code suivant:

Code: 
Select Case Tour


Case "TA"
VCPTA.Imglogo.Picture = TourTA.Controls("image" & Etages).Picture
VCPTA.Imglogo2.Picture = TourTA.Controls("image" & Etages).Picture

NumeroVCP = 1
   Workbooks("temp.xls").Sheets("Feuil1").Select
For NumeroVCP = 1 To 90
On Error Resume Next
   Sheets("Feuil1").Select
    Columns("A:E").Select
    Selection.AutoFilter
    filtre = "CLVCP" & Tour & Format(Etages, "00") & Format(NumeroVCP, "000")
    Selection.AutoFilter Field:=3, Criteria1:=filtre
    Selection.AutoFilter Field:=2, Criteria1:=Format(VCPTA.CbxHeure.Value, "h:mm:ss")

    derligne = Range("E2").End(xlDown).Row

              VCPTA.Controls("Label" & NumeroVCP).Caption = Cells(derligne - 1, 5)
                couleur = Cells(derligne - 2, 5)
                    If couleur = "OC_NUL" Then
                        VCPTA.Controls("Label" & NumeroVCP).BackColor = &HC0C000
                        VCPTA.Controls("Label" & NumeroVCP).Font.Bold = False
                        Else
                        VCPTA.Controls("Label" & NumeroVCP).BackColor = &H80C0FF
                        If couleur = "" Then VCPTA.Controls("Label" & NumeroVCP).BackColor = &HFFFFFF
            End If
                        
                        If couleur = "OC_STANDBY" Then
                       ' VCPTB.Controls("Label" & NumeroVCP).ForeColor = &HC000&
                        VCPTA.Controls("Label" & NumeroVCP).Font.Bold = True
                        End If
                        If couleur = "OC_UNOCCUPIED" Then
                        'VCPTB.Controls("Label" & NumeroVCP).ForeColor = &HC000&
                        VCPTA.Controls("Label" & NumeroVCP).Font.Bold = True
                        End If
                        If couleur = "OC_OCCUPIED" Then
                        VCPTA.Controls("Label" & NumeroVCP).Font.Bold = False
                        End If
           
             DECALAGE = Cells(derligne, 5)
             Select Case DECALAGE
             Case 3
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HC0&
             Case 2
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HFF&
             Case 1
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &H8080FF
             Case 0
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HFFFFFF
             Case -1
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HFFFF80
             Case -2
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HFFFF00
             Case -3
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HAB7332
             Case ""
             VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HE0E0E0
             End Select


     If derligne < 0 Then
                    VCPTA.Controls("Label" & NumeroVCP).BackColor = &HFFFFFF
                    VCPTA.Controls("Label" & NumeroVCP + 100).BackColor = &HE0E0E0
                    VCPTA.Controls("Label" & NumeroVCP).Font.Bold = False
                    VCPTA.Controls("Label" & NumeroVCP).Caption = ""
                    End If



Next NumeroVCP

VCPTA.Caption = "Tour" & " " & Tour & " - " & "NIVEAU" & " " & Etages
VCPTA.LbTourEtage.Caption = "Tour" & " " & Tour & " - " & "NIVEAU" & " " & Etages

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
VCPTA.Show


Case "TB"
VCPTB.Imglogo.Picture = TourTA.Controls("image" & Etages).Picture
VCPTB.Imglogo2.Picture = TourTA.Controls("image" & Etages).Picture

NumeroVCP = 1
   Workbooks("temp.xls").Sheets("Feuil1").Select
    For NumeroVCP = 1 To 90
    On Error Resume Next
   Sheets("Feuil1").Select
    Columns("A:E").Select
    Selection.AutoFilter
    filtre = "CLVCP" & Tour & Format(Etages, "00") & Format(NumeroVCP, "000")
    Selection.AutoFilter Field:=3, Criteria1:=filtre
    Selection.AutoFilter Field:=2, Criteria1:=Format(VCPTB.CbxHeure.Value, "h:mm:ss")

 '   derligne = Range("E2").End(xlDown).Row
'-----------------------------------------------------------
    For i = (Cells(Rows.Count, 1).End(xlUp).Row) - Workbooks("VCP V15 interface.xls").Sheets("config").Range("A48") To Cells(Rows.Count, 1).End(xlUp).Row
        If Rows(i).Hidden = False Then  'donc la ligne est visible
            derligne = i
            Exit For
        End If
    Next
'---------------------------------------------------------------------


              VCPTB.Controls("Label" & NumeroVCP).Caption = Cells(derligne + 1, 5)
                couleur = Cells(derligne, 5)
                   If couleur = "OC_NUL" Then
                        VCPTB.Controls("Label" & NumeroVCP).BackColor = &HC0C000
                        VCPTB.Controls("Label" & NumeroVCP).Font.Bold = False
                        Else
                        VCPTB.Controls("Label" & NumeroVCP).BackColor = &H80C0FF
                        End If
                    
                        If couleur = "OC_STANDBY" Then
                       ' VCPTB.Controls("Label" & NumeroVCP).ForeColor = &HC000&
                        VCPTB.Controls("Label" & NumeroVCP).Font.Bold = True
                        End If
                        If couleur = "OC_UNOCCUPIED" Then
                        'VCPTB.Controls("Label" & NumeroVCP).ForeColor = &HC000&
                        VCPTB.Controls("Label" & NumeroVCP).Font.Bold = True
                        End If
                        If couleur = "OC_OCCUPIED" Then
                        VCPTB.Controls("Label" & NumeroVCP).Font.Bold = False
                        End If
                        
                        

             DECALAGE = Cells(derligne + 2, 5)
             Select Case DECALAGE
             Case 3
             VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &HC0&
             Case 2
             VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &HFF&
             Case 1
             VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &H8080FF
             Case 0
             VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &HFFFFFF
             Case -1
             VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &HFFFF80
             Case -2
             VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &HFFFF00
             Case -3
             VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &HAB7332
             End Select

     If derligne < 0 Then
                    VCPTB.Controls("Label" & NumeroVCP).BackColor = &HFFFFFF
                    VCPTB.Controls("Label" & NumeroVCP + 100).BackColor = &HE0E0E0
                    VCPTB.Controls("Label" & NumeroVCP).Font.Bold = False
                    VCPTB.Controls("Label" & NumeroVCP).Caption = ""
                    End If
Next NumeroVCP


VCPTB.Caption = "Tour" & " " & Tour & " - " & "NIVEAU" & " " & Etages
VCPTB.LbTourEtage.Caption = "Tour" & " " & Tour & " - " & "NIVEAU" & " " & Etages

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
VCPTB.Show


La seul différence c'est les forms qui sont appeler VCPTA ou VCPTB.
Il y a peut être d'autre simplification.

Merci.
 
Trier par date Trier par votes
D

Defcom60

XLDnaute Junior
Re : Simplication de code

Bonjour,

Comment faire pour utiliser un nom générique pour les noms des forms.


EXEMPLE:

j'ai 3 forms qui sont VCPTA, VCPTB, VCPB1
je voudrais utiliser une variable qui définisse le nom de la forms.

noms=VCPTA
noms.label1.caption="test"

y a t'il un moyen de procédé de la sorte.

merci
 
Vote positif 0 Vote négatif
G

Guest

Guest
Re : Simplication de code

Bonjour,

Tu peux peut-être faire une fonction générique comme celle-ci
En supposant qu'il existe deux userform appelés UserForm1 et 2
Code: 
Function MaForme(StrNomUserForm As String) As Object
    Select Case StrNomUserForm
        Case "UserForm1": Set MaForme = UserForm1
        Case "UserForm2": Set MaForme = UserForm2
    End Select
End Function

Utilisation
Code: 
Sub Test()
    Dim usf As Object
    Set usf = MaForme("UserForm1")
    With usf
        .Label1 = "Toto"
        .Show
    End With
End Sub
A+
 
Vote positif 0 Vote négatif
D

Defcom60

XLDnaute Junior
Re : Simplication de code

Merci te ton aide cela fonctionne à merveille.

j'ai une autre question

je voudrais compter les NumeroVCP de 1 à 90 et de 200 à 250

j'ai trouver comment compter de 1 à 90 avec le code suivant mais comment compter de 200 à 250.

Code: 
NumeroVCP = 1
   Workbooks("temp.xls").Sheets("Feuil1").Select
For NumeroVCP = 1 To 90
On Error Resume Next
Sheets("Feuil1").Select
    Columns("A:E").Select
    Selection.AutoFilter
    filtre = "CLVCP" & Tour & Format(Etages, "00") & Format(NumeroVCP, "000")
    Selection.AutoFilter Field:=3, Criteria1:=filtre
    Selection.AutoFilter Field:=2, Criteria1:=Format(VCPTA.CbxHeure.Value, "h:mm:ss")

    'code
   ' code
    'code

next NumeroVCP
 
Vote positif 0 Vote négatif
ROGER2327

ROGER2327

XLDnaute Barbatruc
Re : Simplication de code

Bonjour Defcom60
Remplacez
Code: 
[COLOR="DarkSlateGray"][B]For NumeroVCP = 1 To 90[/B][/COLOR]
par
Code: 
[COLOR="DarkSlateGray"][B]For NumeroVCP = 1 To 250
   If NumeroVCP =91 Then NumeroVCP =200[/B][/COLOR]
ROGER2327
#2290
 
Vote positif 0 Vote négatif

Discussions similaires

F
  • Question
Microsoft 365 Poursuivre ou pas la macro
Réponses
2
Affichages
205
Francky79
F
R
  • Résolu(e)
XL 2013 un seul code pour plusieurs labels click
Réponses
7
Affichages
536
RENAUDcyrille
R
B
  • Résolu(e)
Microsoft 365 affecter des valeurs dans un tableau de noms de variable
Réponses
4
Affichages
430
bérylion
B
R
  • Question
Microsoft 365 Couleur de fond de textbox [CLOTURE]
Réponses
2
Affichages
547
romubzh35
R
U
  • Question
Autres Enregistrer sur Onglet TOTO
Réponses
2
Affichages
391
un internaute
U
L
  • Résolu(e)
XL 2019 Formulaire Excel - TxtBox avec couleur de la celle associée
Réponses
4
Affichages
455
Lindsay_RBD
L
Mathos
  • Résolu(e)
XL 2021 (Résolu) Aide vrai/faux dans plusieurs colonnes de cases à cocher
2
Réponses
27
Affichages
434
Dranreb
Dranreb
C
  • Question
XL 2021 Positionnement sur une cellule en fonction de la date, du jour et de l'heure
Réponses
2
Affichages
242
clausen
C
B
  • Question
XL 2016 Interférence entre une boucle et un copie de feuille
Réponses
4
Affichages
354
Oneida
Oneida
U
  • Question
Autres [RÉSOLU] Faire afficher ligne sur tout le classeur par double clic et la faire maquer à l’enregistrement
Réponses
11
Affichages
438
un internaute
U

Membres actuellement en ligne

9 membres et 133 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 370
Messages
2 087 678
Membres
103 635
dernier inscrit
aime nguessanj