XL 2019 SQL ADODB avec plusieurs lignes en input

VBA_dev_Anne_Marie · 24 Décembre 2022

Joyeux Noël !!!

J'aurais une petite question. Je n'arrive pas à trouver comment indiquer dans le code plusieurs cellules de données en input pour une requête sql adodb.
Voici mon code :

VB:

'Date
Sub Ma_date()

    Dim RECSET As New ADODB.Recordset, numero_de_police
 
    Call CONNEXION_PE("xx", "xx", "xx")
 
    numero = Worksheets("Coûts").Range("A1").Value
 
    If Len(numero) > 0 Then
     
         RECSET.Open " select sousc.no_police as no_police  from dossier sousc,contractant cntr, personne pers" & _
            " where sousc.no_police = '" & numero & "'  and " & _
            " sousc.is_contractant = cntr.is_contractant and pers.is_personne=cntr.is_personne", cnn_Pe, adOpenDynamic, adLockBatchOptimistic
     
           With Worksheets("Coûts").range("C1")
            If Not RECSET.EOF Then
                .Value = RECSET.Fields("no_police").Value
            Else
                .Value = "Inconnu"
            End If
        End With
        RECSET.Close
    End If
Call DECONNEXION_PE
End Sub

En fait, j'aimerais bien prendre en input toutes les numéro dans la colonne A et écrire l'output dans la colonne C :

Pour l'instant, j'arrive à récupère juste le numéro dans la cellule A1, je ne sais pas comment "automatiser" ma requête sur toutes les lignes.

J'aurais aussi une deuxième question : si je récupère plusieurs dates de naissance (plusieurs adhérents par famille ) dans la colonne C, est-il possible d'insérer des colonnes supplémentaires après la colonne C pour récupérer ces dates ?

Merci pour votre aide !

Bon Réveillon !

dysorthographie · 26 Décembre 2022

Bonjour,
Ef fait Marie à fait tout ce qui est nécessaire côté SQL.

Elle veut juste de l'aide pour parcourir de A2:A4

Code:

For i=2 to Worksheets("Coûts").Range("A1").currenteregion.rows.count
numero = Worksheets("Coûts").cells(i,"A").Value
Next

VBA_dev_Anne_Marie · 27 Décembre 2022

dysorthographie à dit:
Bonjour,
Dans ton poste originel tu utilises cnn_Pe comme connexion de ton recordset !

VBA_dev_Anne_Marie · 27 Décembre 2022

dysorthographie à dit:
Bonjour,
Dans ton poste originel tu utilises cnn_Pe comme connexion de ton

dysorthographie à dit:
Bonjour,
Dans ton poste originel tu utilises cnn_Pe comme connexion de ton recordset !

La connexion marche, merci ! En fait, je reçois ce genre d'erreur :

Pour cette ligne :

Voilà ma version du code qui marche, mais j'aimerais bien la réécrire avec une fonction comme vous avez fait :

VB:

Sub Date_de_Naissance()

    Dim RECSET As New ADODB.Recordset, numero_de_police
  
    With Sheets("Coûts").Range("A1").CurrentRegion
    Call CONNEXION_PE("xxx", "xxx", "xxx")
    For I = 2 To .Rows.Count
  
    numero = .Cells(I, "A").Value
  
   


    If Len(numero) > 0 Then

         RECSET.Open " select pers.D_NAISSANCE as D_NAISSANCE  from dossier sousc, contractant cntr, personne pers" & _
            " where sousc.no_police = '" & numero & "'  " & _
            "  and sousc.is_contractant = cntr.is_ctant_pere and pers.is_personne=cntr.is_personne", cnn_Pe, adOpenDynamic, adLockBatchOptimistic

        
            If Not RECSET.EOF Then
                .Cells(I, "C").Value = RECSET.Fields("D_NAISSANCE").Value
            Else
                .Cells(I, "C").Value.Value = "Inconnu"
            End If
 
        RECSET.Close
    End If
    Next
End With
Call DECONNEXION_PE
End Sub

Merci pour votre aide !

fanch55 · 29 Décembre 2022

Re,
Essayez ce code :

VB:

Sub Ma_date_New()
   
    Call Connexion_Pe("xx", "xx", "xx")
   
    Dim Sel_Pol As String
    Nl = 3 ' nombre de lignes (polices)  à prendre en compte
    Nr = 2 ' numéro de ligne de début de données
    For Each Cel In Application.Transpose(Cells(Nr, "A").Resize(Nl))
        Sel_Pol = IIf(Sel_Pol = "", "'", Sel_Pol & ",'") & Cel & "'"
    Next

    Dim RECSET As Object
    Set RECSET = CreateObject("ADODB.recordset")
        RECSET.Open _
            " select sousc.no_police as no_police " & _
                " from dossier sousc,contractant cntr, personne pers " & _
                " where sousc.is_contractant = cntr.is_contractant   " & _
                "   and     pers.is_personne = cntr.is_personne      " & _
                "   and      sousc.no_police in (" & Sel_Pol & ")", _
            cnn_Pe, adOpenDynamic, adLockBatchOptimistic
   
            If Not RECSET.EOF Then
                Cells(Nr, "C").CopyFromRecordset RECSET
                With Cells(Nr, "D").Resize(RECSET.RecordCount)
                    .FormulaR1C1 = "=IF(RC[-1]="""","""",DATEDIF(RC[-1],TODAY(),""y""))"
                    .NumberFormat = "General"
                End With
            Else
                MsgBox "Pas d'enregistrements correspondants à" & vbLf & Sel_Pol
            End If

        RECSET.Close
    Set RECSET = Nothing
   
    Call Deconnexion_Pe
End Sub

XL 2019 SQL ADODB avec plusieurs lignes en input

VBA_dev_Anne_Marie

XLDnaute Occasionnel

Pièces jointes

dysorthographie

VBA_dev_Anne_Marie

XLDnaute Occasionnel

VBA_dev_Anne_Marie

XLDnaute Occasionnel

fanch55

XLDnaute Barbatruc

Discussions similaires