Récupération données XL pour alimenter un formulaire ss word

Pour écrire et partager des tutoriels et des astuces (Excel, Calc et Google Sheets uniquement)
Avatar du membre
SylChat
Membre fidèle
Membre fidèle
Messages : 189
Inscrit le : 5 août 2013
Version d'Excel : 2003 FR / 2010FR

Message par SylChat » 30 août 2016, 11:30

Bonjour,

Je cherchais à me faire une macro pour lire les données présent dans un fichier xlsm afin qu'elles alimentent une listview dans un formulaire d'un fichier word.
Tout ça pour en faire des étiquettes.
J'ai un peu galéré mais j'ai réussi ma macro et je vous la partage, on ne sais jamais ça peut servir.

Mon fichier xlsm contient des données dont les colonnes sont Date_de_réception, N_Demande, Test, Lot
Le fichier word contient donc un formulaire "EtqExtract", il y a dedans une listview "ListExt" qui contient 3 colonnes à alimenter.
A partir d'un autre formulaire je renseigne sDate, eDate et Test qui serviront pour la requète et je lance ma macro
'Macro de remplissage auto du formulaire pour les étiquettes depuis le fichier
Sub EnvoieData(sDate As Date, eDate As Date, ByVal Test As String)
    Dim Cn As ADODB.Connection
    Dim Rs As ADODB.Recordset
    
    EtqExtract.Show 0 'affichage du formulaire

    'Connection au fichier pour lire les données
    Set Cn = New ADODB.Connection
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=NomFichier.xlsm;Extended Properties=Excel 12.0 Xml;"
    'Définition de la requète (choix du test et de l'intervalle de date de réception des échantillons)
    Set Rs = New ADODB.Recordset
    Set Rs = Cn.Execute("SELECT N_Demande, Lot, Test, Date_de_réception FROM Réception WHERE Test='" & Test & "' AND Date_de_réception> #" & sDate & "# AND Date_de_réception< #" & eDate & "#")
    X = 1
    'renseigne la liste du formulaire en bouclant sur la requète
    Do While Not Rs.EOF
        EtqExtract.ListExt.ListItems.Add , , Rs(0).Value
        EtqExtract.ListExt.ListItems(X).ListSubItems.Add , , Rs(1).Value
        EtqExtract.ListExt.ListItems(X).ListSubItems.Add , , "5"
        Rs.MoveNext
        X = X + 1
    Loop
    Cn.Close 'Ferme la connexion avec le fichier excel
    Set Cn = Nothing
   Set Rs=Nothing
End Sub
J'espère que cela pourra servir à quelqu'un.

Bonne journée
Chercher, Trouver, Comprendre, Essayer & Assimiler...
c'est comme ça qu'on apprend par soi-même
Répondre Sujet précédentSujet suivant
  • Sujets similaires
    Réponses
    Vues
    Dernier message