Microsoft 365 Valeur d'une liste dans la requête ADODB

[VBA_dev_Anne_Marie]

Bonjour,

J'ai une liste déroulante avec des valeurs. Je voudrais cliquer dans cette liste et afficher la valeur correspondante via une requête ADODB dans une autre cellule.
Mon code pour passer la valeur de la liste dans une variable que je vais utiliser dans la requête est:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Address(0, 0) = "E15" Then
GET_GROUPE Split(Target.Value, " - ")(1)
End If
End Sub


J'ai mis Split(Target.Value, " - ")(1) car mes variables se presente comme LMM - 55C, KPCF - 5577 , je dois récupérer les caractères après le tiret. Ce code ne marche pas

 

[laurent950]

Re
Qu'elle est le code de cette Procédure ? GET_GROUPE_GESTION_CIBLE

 

[laurent950]

Re,

ici Dim TabRes() As String
Paracerque Public Sub GET_GROUPE_GESTION_CIBLE(ByRef strQ As String)

Pour ByRef et ByVal : Poste #25 @Dranreb jusqu'au poste #30 (J'ai écrit quelques exemples)
Lien : Propriétés d"une classe | Page 2 | Excel-Downloads (excel-downloads.com)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    If Not Intersect(Target, Range("C6")) Is Nothing Then
        Call CLICK_BTN_INFOS_CONTRAT
    End If

    Dim TabRes() As String
    If Target.Value = [E15].Value Then
        ReDim TabRes(0 To UBound(Split([Target], ",")))
        For i = LBound(TabRes) To UBound(TabRes)
            TabRes(i) = Split(Split([Target], ",")(i), "-")(1)
        Next i
    End If
    MsgBox TabRes(0)
    GET_GROUPE_GESTION_CIBLE TabRes(0)
End Sub

Public Sub GET_GROUPE_GESTION_CIBLE(ByRef strQ As String)
    Dim cnn_Pegase As ADODB.Connection 'Connexion Pegase
    Dim RECSET As New ADODB.Recordset
        Call CONNEXION_PEG("select", "test", "PEG")
    RECSET.Open "select serv.lb_long||' (AT: '||pers.s_nom||' '||pers.s_prenom||')' as groupecible from db_tiers as ti, dr_collaborateur_tiers cp,db_collaborateur col,db_personne pers,dr_service_collaborateur sc,db_service_compagnie serv" & _
                " where ti.CD_TIERS='" & strQ & "' ti.is_tiers=cp.is_tiers and cp.is_collaborateur = col.is_collaborateur and col.is_personne = pers.is_personne and col.is_collaborateur = sc.is_collaborateur and sc.is_service_compagnie = serv.is_service_compagnie", cnn_Pegase, adOpenDynamic, adLockBatchOptimistic
    If Not RECSET.EOF Then
        Worksheets("1 - Feuille de Suivi Commercial").Range("GET_GROUPE_GESTION_CIBLE").Value = RECSET.Fields("groupecible").Value
    Else
        Worksheets("1 - Feuille de Suivi Commercial").Range("GET_GROUPE_GESTION_CIBLE").Value = "Inconnu"
    End If
    RECSET.Close
    Call DECONNEXION_PEG
End Sub

 

[VBA_dev_Anne_Marie]

Re,

ici Dim TabRes() As String
Paracerque Public Sub GET_GROUPE_GESTION_CIBLE(ByRef strQ As String)

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer
    If Not Intersect(Target, Range("C6")) Is Nothing Then
        Call CLICK_BTN_INFOS_CONTRAT
    End If

    Dim TabRes() As String
    If Target.Value = [E15].Value Then
        ReDim TabRes(0 To UBound(Split([Target], ",")))
        For i = LBound(TabRes) To UBound(TabRes)
            TabRes(i) = Split(Split([Target], ",")(i), "-")(1)
        Next i
    End If
    MsgBox TabRes(0)
    GET_GROUPE_GESTION_CIBLE TabRes(0)
End Sub

Public Sub GET_GROUPE_GESTION_CIBLE(ByRef strQ As String)
    Dim cnn_Pegase As ADODB.Connection 'Connexion Pegase
    Dim RECSET As New ADODB.Recordset
        Call CONNEXION_PEG("select", "test", "PEG")
    RECSET.Open "select serv.lb_long||' (AT: '||pers.s_nom||' '||pers.s_prenom||')' as groupecible from db_tiers as ti, dr_collaborateur_tiers cp,db_collaborateur col,db_personne pers,dr_service_collaborateur sc,db_service_compagnie serv" & _
                " where ti.CD_TIERS='" & strQ & "' ti.is_tiers=cp.is_tiers and cp.is_collaborateur = col.is_collaborateur and col.is_personne = pers.is_personne and col.is_collaborateur = sc.is_collaborateur and sc.is_service_compagnie = serv.is_service_compagnie", cnn_Pegase, adOpenDynamic, adLockBatchOptimistic
    If Not RECSET.EOF Then
        Worksheets("1 - Feuille de Suivi Commercial").Range("GET_GROUPE_GESTION_CIBLE").Value = RECSET.Fields("groupecible").Value
    Else
        Worksheets("1 - Feuille de Suivi Commercial").Range("GET_GROUPE_GESTION_CIBLE").Value = "Inconnu"
    End If
    RECSET.Close
    Call DECONNEXION_PEG
End Sub

Merci ! C'est beaucoup mieux maintenant! Par contre j'ai une erreur de connexion.

 

[VBA_dev_Anne_Marie]

Merci ! C'est beaucoup mieux maintenant! Par contre j'ai une erreur de connexion.Regarde la pièce jointe 1091712

Est-ce que les call connexion / déconnexion sont dans le bon endroit dans mon code ? Merci

 

[VBA_dev_Anne_Marie]

Je vois rien d'anormal ici:

 

[laurent950]

Re,
Peut être avec cette page pour faire la correction de votre connexion avec votre base de donnée extrene
Erreur d'exécution SQL VBA Excel 3709 Connexion invalide (stackoverrun.com)

 

[VBA_dev_Anne_Marie]

Merci! Malheureusement, je n'ai pas de chemin vers ma base de données, c'est un serveur à distance. Du coup, je ne sais pas si je peux me fier à cet exemple.

 

[VBA_dev_Anne_Marie]

Comme je suis débutante en VBA, je voudrais juste savoir si j'ai mis des connexions dans les bons endroits dans le programme, car j'analyse plutôt cette anomalie. Merci

 

[laurent950]

Re,
Il y a une première partie qui est bien, pour les connexion à votre base je ne sais pas.

Cdt

 

[VBA_dev_Anne_Marie]

Re,
Il y a une première partie qui est bien, pour les connexion à votre base je ne sais pas.

Cdt

Merci

 

[VBA_dev_Anne_Marie]

Re,
Target c'est une variable Objet de Type Range (La valeur ou plage de valeur renvoyé)
On peut stocker le résultat dans une variable tableau comme l'exemple que j'ai posté

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TabRes() As Variant
If Target.Value = [E15].Value Then
    ReDim TabRes(0 To UBound(Split([Target], ",")))
        For i = LBound(TabRes) To UBound(TabRes)
            TabRes(i) = Split(Split([Target], ",")(i), "-")(1)
        Next i
End If
MsgBox TabRes(0)
MsgBox TabRes(1)
End Sub

cdt

Bonjour,
J’ai remarqué que je reçois un espace à droite dans la Tab_Res, par conséquent ma requête ne marche pas. Est-ce que vous connaissez une fonction VBA qui supprime des espaces ? Merci !

 

[Hasco]

Bonjour,

Essayez TRIM(TabRes(0)) qui supprimera les espaces en début et en fin.

GET_GROUPE_GESTION_CIBLE TRIM(TabRes(0))

Cordialement

 

[VBA_dev_Anne_Marie]

Bonjour,

Essayez TRIM(TabRes(0)) qui supprimera les espaces en début et en fin.



Cordialement

Oui, super, ça marche ! Merci beaucoup !