Combobox depuis excel

Version imprimable

07/04/2014, 11h12
Slackk

Combobox depuis excel

Bonjour,
Comment remplir une combobox d'un form sur word depuis une source colonne d'un fichier excel ?
cdt
07/04/2014, 13h33
Heureux-oli

Salut,

Une piste là : http://heureuxoli.developpez.com/off...ent-tiroir/#L3

Edit : Trouvé

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
Dim iR As Integer
Dim i As Integer
Dim oDoc As Document
Dim oDS As MailMergeDataSource
Dim xlApp As Excel.Application 'Application Excel pour ouvrir un fichier XLS
Dim xlWb As Excel.Workbook 'Classeur Excel
Dim xlWs As Excel.Worksheet 'Feuille du classeur
chemin = ActiveDocument.Path & "\test.xlsx"
 
Set xlApp = New Excel.Application
'Ouverture du fichier
Set xlWb = xlApp.Workbooks.Open(chemin)
'Utilisation de la première feuille
Set xlWs = xlWb.Worksheets(1)
Set oDoc = ActiveDocument
Set oDS = oDoc.MailMerge.DataSource
 
oDoc.MailMerge.DataSource.ActiveRecord = wdLastRecord
iR = oDoc.MailMerge.DataSource.ActiveRecord
oDoc.MailMerge.DataSource.ActiveRecord = wdFirstRecord
 
'Récupère les données de la colonne M...
For j = 2 To iR
ComboBox1 = xlWs.Range("M" & j)
'...et filtre les doublons
If ComboBox1.ListIndex = -1 Then ComboBox1.AddItem xlWs.Range("M" & j)
Next j
 
End Sub

19/09/2018, 17h44
zazadec16

Hi,
Je n'arrive pas à réutiliser ce code. Il me fait une belle erreur "Requested Object is not available"
J'ai du oublié de déclarer une référence dans VBA de mon nouveau PC. Mais laquelle ?
Références Microsoft Excel 15.0 Object Librairy est bien activée.

Qu'est ce que j'oublie ?

Citation:

Envoyé par zazadec16

Bonjour,

Combobox1 fait partie de ThisDocument.

Une autre solution en utilisant un objet dictionnaire et une matrice pour éliminer les doublons et charger la liste :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
 
Option Explicit
 
Public ListeCle As Variant, ListeElement As Variant
 
Sub ChargerLaCombobox1()
 
Dim J As Long, DerniereLigne As Long
Dim Chemin As String
 
Dim xlApp As Excel.Application 'Application Excel pour ouvrir un fichier XLS
Dim xlWb As Excel.Workbook     'Classeur Excel
Dim xlWs As Excel.Worksheet    'Feuille du classeur
 
        On Error GoTo Fin:
 
        Chemin = ActiveDocument.Path & "\test.xlsm" ' "\test.xlsx"
 
        Set xlApp = New Excel.Application
        Set xlWb = xlApp.Workbooks.Open(Chemin) 'Ouverture du fichier
        Set xlWs = xlWb.Worksheets(1)           'Utilisation de la première feuille
 
        With xlWs
             DerniereLigne = .UsedRange.SpecialCells(xlCellTypeLastCell).Row
             If DerniereLigne <= 2 Then GoTo Fin
             ChargerEtTrierLaListe .Range("M2:M" & DerniereLigne)
        End With
 
        'Récupère les données triées de la matrice ListeCle
        With ThisDocument
             .ComboBox1.Clear
             For J = LBound(ListeCle) To UBound(ListeCle)
                 .ComboBox1.AddItem ListeCle(J)
             Next J
             .ComboBox1.ListIndex = 0
        End With
 
Fin:
 
        xlWb.Close savechanges:=False
        xlApp.Quit
 
        Set xlWs = Nothing
        Set xlWb = Nothing
        Set xlApp = Nothing
 
End Sub
 
 
 
Sub ChargerEtTrierLaListe(ByVal AireCombo As Excel.Range)
 
Dim CelluleCombo As Excel.Range
Dim CtrI As Integer, CtrJ As Integer
Dim Tempo1, Tempo2
Dim MaListe As Object
 
    On Error GoTo FinDico
 
    Set MaListe = CreateObject("Scripting.Dictionary")
 
    ' Ajout des différents enregistrements sans doublons dans le Dico
    '-----------------------------------------------------------------
    For Each CelluleCombo In AireCombo
        If Trim(CelluleCombo.Value) <> "" Then
           If Not MaListe.Exists(CelluleCombo.Value) Then
              MaListe.Add (CelluleCombo.Value), CStr(CelluleCombo.Value)
           End If
        End If
     Next CelluleCombo
 
     ListeCle = MaListe.Keys
     ListeElement = MaListe.Items
 
     ' Tri par ordre alphabétique
     '----------------------------
     For CtrI = 0 To MaListe.Count - 2
         For CtrJ = CtrI + 1 To MaListe.Count - 1
             If ListeElement(CtrI) > ListeElement(CtrJ) Then
 
                Tempo1 = ListeCle(CtrJ)
                Tempo2 = ListeElement(CtrJ)
 
                ListeElement(CtrJ) = ListeElement(CtrI)
                ListeCle(CtrJ) = ListeCle(CtrI)
 
                ListeCle(CtrI) = Tempo1
                ListeElement(CtrI) = Tempo2
 
             End If
          Next CtrJ
      Next CtrI
 
      GoTo FinDico
 
FinDico:
 
  Set MaListe = Nothing
 
End Sub