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

VBA_dev_Anne_Marie · 14 Janvier 2021

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 · 15 Janvier 2021

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

laurent950 · 15 Janvier 2021

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)

VB:

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 · 15 Janvier 2021

laurent950 à dit:

Re,

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

VB:

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 · 15 Janvier 2021

MarieParis à dit:
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 · 15 Janvier 2021

Je vois rien d'anormal ici:

laurent950 · 15 Janvier 2021

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 · 15 Janvier 2021

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 · 15 Janvier 2021

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 · 15 Janvier 2021

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 · 15 Janvier 2021

laurent950 à dit:
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 · 18 Janvier 2021

laurent950 à dit:
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é

VB:

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 · 18 Janvier 2021

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 · 18 Janvier 2021

Roblochon à dit:
Bonjour,

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

Cordialement

Oui, super, ça marche ! Merci beaucoup !

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

VBA_dev_Anne_Marie

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

laurent950

XLDnaute Barbatruc

VBA_dev_Anne_Marie

XLDnaute Occasionnel

VBA_dev_Anne_Marie

XLDnaute Occasionnel

VBA_dev_Anne_Marie

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

VBA_dev_Anne_Marie

XLDnaute Occasionnel

VBA_dev_Anne_Marie

XLDnaute Occasionnel

laurent950

XLDnaute Barbatruc

VBA_dev_Anne_Marie

XLDnaute Occasionnel

VBA_dev_Anne_Marie

XLDnaute Occasionnel

Hasco

XLDnaute Barbatruc

VBA_dev_Anne_Marie

XLDnaute Occasionnel

Discussions similaires