Dans un Userform faire appelle à un TCD

Le 02/11/2020 à 09:49

Bonjour,

J'ai besoin de votre aide. Actuellement j'ai un projet de VBA qui consiste à extraire de l'information depuis une base de données.

Pour ce faire j'ai utilisé un Userform avec des Textbox pour afficher l'information.

Maintenant j'aimerai que lorsque je fais un double click sur le TextBox, il m'extrait la partie de la base de données dont j'ai l'information. Comme dans un tableau croisé dynamique.

Est-ce que vous pouvez me dire quel commande il s'agit ?

Voici mon code pour comprendre un peu plus, (le fichier est très lourd.

Private Sub Miseàjour_Click()

    Dim ligne As Long
    Dim O As Worksheet
    Dim TV As Variant

    Dim Critere1 As Long
    Dim Critere1bis As Long
    Dim Critere2 As Long
    Dim Critere2bis As Long
    Dim Critere3 As Long
    Dim Critere3bis As Long
    Dim Critere4 As Long
    Dim Critere4bis As Long
    Dim Critere5 As Long
    Dim Critere5bis As Long
    Dim Critere6 As Long
    Dim Critere6bis As Long
    Dim Critere7 As Long
    Dim Critere7bis As Long
    Dim Critere8 As Long
    Dim Critere8bis As Long
    Dim Critere9 As Long
    Dim Critere9bis As Long
    Dim Critere10 As Long
    Dim Critere10bis As Long
    Dim Critere11 As Long
    Dim Critere11bis As Long
    Dim Critere12 As Long
    Dim Critere12bis As Long
    Dim Critere13 As Long
    Dim Critere13bis As Long
    Dim Critere14 As Long
    Dim Critere14bis As Long
    Dim Critere15 As Long
    Dim Critere15bis As Long
    Dim Critere16 As Long
    Dim Critere16bis As Long
    Dim Critere17 As Long
    Dim Critere17bis As Long
    Dim Critere18 As Long
    Dim Critere18bis As Long
    Dim Critere19 As Long
    Dim Critere19bis As Long
    Dim Critere20 As Long
    Dim Critere20bis As Long
    Dim Critere21 As Long
    Dim Critere21bis As Long

    Dim Total As Long
    Dim Intermediaire1 As Long
    Dim Intermediaire2 As Long
    Dim Intermediaire3 As Long
    Dim Intermediaire4 As Long
    Dim Intermediaire5 As Long
    Dim Intermediaire6 As Long
    Dim Intermediaire7 As Long
    Dim Intermediaire8 As Long
    Dim Intermediaire9 As Long

    Set O = Worksheets("Feuil1")
    TV = O.Range("A1").CurrentRegion

    Critere1 = 0
    Critere1bis = 0
    Critere2 = 0
    Critere2bis = 0
    Critere3 = 0
    Critere3bis = 0
    Critere4 = 0
    Critere4bis = 0
    Critere5 = 0
    Critere5bis = 0
    Critere6 = 0
    Critere6bis = 0
    Critere7 = 0
    Critere7bis = 0
    Critere8 = 0
    Critere8bis = 0
    Critere9 = 0
    Critere9bis = 0
    Critere10 = 0
    Critere10bis = 0
    Critere11 = 0
    Critere11bis = 0
    Critere12 = 0
    Critere12bis = 0
    Critere13 = 0
    Critere13bis = 0
    Critere14 = 0
    Critere14bis = 0
    Critere15 = 0
    Critere15bis = 0
    Critere16 = 0
    Critere16bis = 0
    Critere17 = 0
    Critere17bis = 0
    Critere18 = 0
    Critere18bis = 0
    Critere19 = 0
    Critere19bis = 0
    Critere20 = 0
    Critere20bis = 0
    Critere21 = 0
    Critere21bis = 0

        For ligne = 3 To UBound(TV, 1)

            'Critère 1
            If TV(ligne, 122) <> "" Then
            Critere1bis = TV(ligne, 51)
            Critere1 = Critere1 + Critere1bis
            End If

            'Critère 2
            If TV(ligne, 122) = "" And TV(ligne, 66) = "Obsolète_Vétuste" Then
            Critere2bis = TV(ligne, 51)
            Critere2 = Critere2 + Critere2bis
            End If

            'Critère 3
            If TV(ligne, 122) = "" And cells(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) = "Oui" And (TV(ligne, 33) <> "SIGNE" Or TV(ligne, 129) <> "Présent") Then
            Critere3bis = TV(ligne, 51)
            Critere3 = Critere3 + Critere3bis
            End If

            'Critère 4
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Oui" And TV(ligne, 91) = "Syndic" And TV(ligne, 92) = "Propriétaire non identifié" Then
            Critere4bis = TV(ligne, 51)
            Critere4 = Critere4 + Critere4bis
            End If

            'Critère 5
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And (TV(ligne, 147) <> "" Or TV(ligne, 149) <> "") Then
            Critere5bis = TV(ligne, 51)
            Critere5 = Critere5 + Critere5bis
            End If

            'Critère 6
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Oui" And TV(ligne, 91) = "Syndic" And (TV(ligne, 92) = "Accord syndic dénoncé ou en renégo" Or TV(ligne, 92) = "Adduction privative bouchée ou cassée" Or TV(ligne, 92) = "Adduction privative inexistante" Or TV(ligne, 92) = "DTA absent" Or TV(ligne, 92) = "Passage en apparent nécessaire" Or TV(ligne, 92) = "PB accès col montante opérateur câble" Or TV(ligne, 92) = "Problème d’accès IMB" Or TV(ligne, 92) = "Problème passage en partie privative") Then
            Critere6bis = TV(ligne, 51)
            Critere6 = Critere6 + Critere6bis
            End If

            'Critère 7
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Oui" And (TV(ligne, 91) = "Syndic" And (TV(ligne, 92) = "Refus de passage en domaine privé" Or TV(ligne, 92) = "Refus travaux tiers domaine privé") Or (TV(ligne, 91) = "UI" And (TV(ligne, 92) = "Refus ABF" Or TV(ligne, 92) = "Problème d'accès")) Or (TV(ligne, 91) = "Technique" And (TV(ligne, 92) = "Création Aérien refus Tiers" Or TV(ligne, 92) = "Création Souterrain refus tiers" Or TV(ligne, 92) = "Problème GC existant refus Tiers" Or TV(ligne, 92) = "Refus réalisation élagage"))) Then
            Critere7bis = TV(ligne, 51)
            Critere7 = Critere7 + Critere7bis
            End If

            'Critère 8
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) = "Oui" And TV(ligne, 33) = "SIGNE" And TV(ligne, 129) <> "Pas présent" And TV(ligne, 158) > DateAdd("m", -6, Date) And TV(ligne, 158) <> "" Then
            Critere8bis = TV(ligne, 51)
            Critere8 = Critere8 + Critere8bis
            End If

            'Critere 9 n'existe pas
            'Critere 10 n'existe pas

            'Critère 11
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) = "Oui" And TV(ligne, 33) = "SIGNE" And TV(ligne, 129) <> "Pas présent" And (TV(ligne, 158) < DateAdd("m", -6, Date) Or TV(ligne, 158) = "") Then
            Critere11bis = TV(ligne, 51)
            Critere11 = Critere11 + Critere11bis
            End If

            'Critère 12
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Oui" And TV(ligne, 92) <> "Refus de passage en domaine privé" And TV(ligne, 92) <> "Refus travaux tiers domaine privé" And TV(ligne, 92) <> "Propriétaire non identifié" And TV(ligne, 92) <> "Refus ABF" And TV(ligne, 92) <> "Problème d’accès" And TV(ligne, 92) <> "Refus réalisation élagage" And TV(ligne, 92) <> "Problème GC existant refus Tiers" And TV(ligne, 92) <> "Création Souterrain refus tiers" And TV(ligne, 92) <> "Création Aérien refus Tiers" And TV(ligne, 92) <> "TD1 non fait" And TV(ligne, 92) <> "Accord syndic dénoncé ou en renégo" And TV(ligne, 92) <> "Adduction privative bouchée ou cassée" And TV(ligne, 92) <> "Adduction privative inexistante" And TV(ligne, 92) <> "DTA absent" And TV(ligne, 92) <> "Passage en apparent nécessaire" And TV(ligne, 92) <> "PB accès col montante opérateur câble" Then
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Oui" And TV(ligne, 92) <> "Problème d’accès IMB" And TV(ligne, 92) <> "Problème passage en partie privative" Then
            Critere12bis = TV(ligne, 51)
            Critere12 = Critere12 + Critere12bis
            End If
            End If

            'Critère 13
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) <> "Oui" And ((TV(ligne, 170) = "" And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) = "" And TV(ligne, 39) = "Immeuble")) Then
            Critere13bis = TV(ligne, 51)
            Critere13 = Critere13 + Critere13bis
            End If

            'Critère 14
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) <> "Oui" And ((TV(ligne, 170) <> "" And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) <> "" And TV(ligne, 39) = "Immeuble")) And TV(ligne, 171) = "Non" And ((TV(ligne, 170) <= 31 / 12 / 2018 And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) <= DateAdd("ww", -52, Date) And TV(ligne, 39) = "Immeuble")) Then
            Critere14bis = TV(ligne, 51)
            Critere14 = Critere14 + Critere14bis
            End If

            'Critère 15
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Oui" And (TV(ligne, 91) = "Technique" And (TV(ligne, 92) = "SRCT D3 inf 6 mois" Or TV(ligne, 92) = "SRCT D1D2 inf 6 mois" Or TV(ligne, 92) = "DEC D1D2 inf 6 mois" Or TV(ligne, 92) = "DEC D3 inf 6 mois") Or (TV(ligne, 91) = "UI" And (TV(ligne, 92) = "SRCT D3 sup 6 mois" Or TV(ligne, 92) = "SRCT D1D2 sup 6 mois" Or TV(ligne, 92) = "DEC D1D2 sup 6 mois" Or TV(ligne, 92) = "DEC D3 sup 6 mois"))) Then
            Critere15bis = TV(ligne, 51)
            Critere15 = Critere15 + Critere15bis
            End If

            'Critère 16
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) <> "Oui" And ((TV(ligne, 170) <> "" And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) <> "" And TV(ligne, 39) = "Immeuble")) And TV(ligne, 171) = "Oui" Then
            Critere16bis = TV(ligne, 51)
            Critere16 = Critere16 + Critere16bis
            End If

            'Critere 17 n'existe pas

            'Critère 18
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) <> "Oui" And ((TV(ligne, 170) <> "" And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) <> "" And TV(ligne, 39) = "Immeuble")) And TV(ligne, 171) = "Non" And ((TV(ligne, 170) > 31 / 12 / 2018 And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) > DateAdd("ww", -52, Date) And TV(ligne, 39) = "Immeuble")) And TV(ligne, 160) <> "" And TV(ligne, 111) <> "" Then
            Critere18bis = TV(ligne, 51)
            Critere18 = Critere18 + Critere18bis
            End If

            'Critère 19
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) <> "Oui" And ((TV(ligne, 170) <> "" And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) <> "" And TV(ligne, 39) = "Immeuble")) And TV(ligne, 171) = "Non" And ((TV(ligne, 170) > 31 / 12 / 2018 And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) > DateAdd("ww", -52, Date) And TV(ligne, 39) = "Immeuble")) And TV(ligne, 160) = "" Then
            Critere19bis = TV(ligne, 51)
            Critere19 = Critere19 + Critere19bis
            End If

            'Critère 20
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Non" And TV(ligne, 128) <> "Oui" And ((TV(ligne, 170) <> "" And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) <> "" And TV(ligne, 39) = "Immeuble")) And TV(ligne, 171) = "Non" And ((TV(ligne, 170) > 31 / 12 / 2018 And TV(ligne, 39) = "Maison") Or (TV(ligne, 155) > DateAdd("ww", -52, Date) And TV(ligne, 39) = "Immeuble")) And TV(ligne, 160) <> "" And TV(ligne, 111) = "" Then
            Critere20bis = TV(ligne, 51)
            Critere20 = Critere20 + Critere20bis
            End If

            'Critère 21
            If TV(ligne, 122) = "" And TV(ligne, 66) <> "Obsolète_Vétuste" And TV(ligne, 147) = "" And TV(ligne, 149) = "" And TV(ligne, 37) = "Oui" And TV(ligne, 91) = "UI" And TV(ligne, 92) = "TD1 non fait" Then
            Critere21bis = TV(ligne, 51)
            Critere21 = Critere21 + Critere21bis
            End If

        Next ligne

    'Le total de tous les critères
    Total = Critere1 + Critere2 + Critere3 + Critere4 + Critere5 + Critere6 + Critere7 + Critere8 + Critere11 + Critere12 + Critere13 + Critere14 + Critere15 + Critere16 + Critere18 + Critere19 + Critere20 + Critere21

    Critère1.Value = Critere1
    TotalLogementsRaccordable.Value = Critere1

    Critère2.Value = Critere2
    Critère3.Value = Critere3
    Critère4.Value = Critere4
    TotalHorsResponsabilité.Value = Critere2 + Critere3 + Critere4

    Critère5.Value = Critere5
    Critère6.Value = Critere6
    Critère7.Value = Critere7
    TotalLogementsenRefusTiers.Value = Critere5 + Critere6 + Critere7

    Critère8.Value = Critere8
    Critère21.Value = Critere21
    TotalLogementsnontraitésenstandbyindicateur.Value = Critere8 + Critere9 + Critere10 + Critere21

    Critère11.Value = Critere11
    Critère12.Value = Critere12
    Critère13.Value = Critere13
    Critère14.Value = Critere14
    Critère19.Value = Critere19
    TotalLogementsnontraités.Value = Critere11 + Critere12 + Critere13 + Critere14 + Critere19

    Critère15.Value = Critere15
    Critère16.Value = Critere16
    TotalLogementsRaccordablesurDemande.Value = Critere15 + Critere16

    Critère18.Value = Critere18
    Critère20.Value = Critere20
    TotalLogementsétudiéseninstancedeprodsansblocage.Value = Critere17 + Critere18 + Critere20

    'Tronçon pricipal
    Intermédiaire1.Value = Total - Critere1
    Intermédiaire2.Value = Total - Critere1 - Critere2
    Intermédiaire3.Value = Total - Critere1 - Critere2 - Critere5
    Intermédiaire4.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15
    Intermédiaire5.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15 - Critere3 - Critere8 - Critere11
    Intermédiaire6.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15 - Critere3 - Critere8 - Critere11 - Critere13
    Intermédiaire7.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16
    Intermédiaire8.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16 - Critere14
    Intermédiaire9.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16 - Critere14 - Critere19

    Intermédiaire10.Value = Total - Critere1 - Critere2 - Critere5 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16 - Critere14 - Critere19 - Critere20 - Critere18
    Intermédiaire11.Value = Total - Critere1 - Critere2 - Critere5 - Critere6 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16 - Critere14 - Critere19 - Critere20 - Critere18
    Intermédiaire12.Value = Total - Critere1 - Critere2 - Critere5 - Critere6 - Critere7 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16 - Critere14 - Critere19 - Critere20 - Critere18
    Intermédiaire13.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16 - Critere14 - Critere19 - Critere20 - Critere18
    Intermédiaire14.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere3 - Critere8 - Critere11 - Critere13 - Critere16 - Critere14 - Critere19 - Critere20 - Critere18
    Intermédiaire15.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15 - Critere13 - Critere16 - Critere14 - Critere19 - Critere20 - Critere18
    Intermédiaire16.Value = Total - Critere1 - Critere2 - Critere4 - Critere5 - Critere6 - Critere7 - Critere21 - Critere12 - Critere15 - Critere3 - Critere13 - Critere16 - Critere14 - Critere19 - Critere20 - Critere18

End Sub

Merci d'avance

Le 03/11/2020 à 01:20

Bonjour,

Ouille youille

Il faut utiliser des tableaux plutôt que cette liste interminable de variables

Le 03/11/2020 à 11:43

Bonjour,

Merci, je ne savais pas que l'on pouvais faire cela. C'est vrai que j'ai un peu galéré pour écrire les conditions

Rechercher des sujets similaires à "userform appelle tcd"