Combox via Excel

**Max2Gr** · 09/07/2020, 18h31

Merci, mais ce n'est pas ce que je cherche à reproduire...

Je n'ai pas besoin de listbox, encore une fois ceci est juste un exemple pour pouvoir refaire le code sur mon projet existant, mon projet de comporte pas de listbox et encore moins de "région, de villes etc"... c'est juste avoir un exemple de code à reproduire.

Pour ce qui est d'insérer les items choisi sur des signets, j'ai déjà trouver le code.

Ce que je cherche vraiment c'est ce que vous avez reproduit dans votre exemple plus haut, sur l'image ci dessous, mais en word.

Nom : Capture.JPG
Affichages : 81
Taille : 21,0 Ko

Nom : Capture.JPG
Affichages : 81
Taille : 21,0 Ko

Merci

Invité · 11/07/2020, 04h09

Envoyé par Max2Gr

Soit la série de tableaux structurés comme dans ce vidage d'écran :
Nb : Les champs ne contenant que des chiffres comme le département sont précédés du signe ' pour les typer alphanumériques.

Pièce jointe 574827

Dans un module standard du document :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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 MatriceRegions() As Variant, MatriceDep() As Variant, MatriceVilles() As Variant, MatriceCodes() As Variant
 
Sub LancerLaBoiteDeDialogue()
 
Dim IndexRegions As Integer
 
    Application.ScreenUpdating = False
    ChargerLesMatrices
    Application.ScreenUpdating = True
 
    With UserForm1
 
         .ComboBoxRegions.Clear
         .ComboBoxDep.Clear
         .ComboBoxVilles.Clear
         .ComboBoxCodes.Clear
 
         For IndexRegions = LBound(MatriceRegions) To UBound(MatriceRegions)
             .ComboBoxRegions.AddItem MatriceRegions(IndexRegions)
         Next IndexRegions
         .ComboBoxRegions.ListIndex = -1
 
         .Show
 
    End With
 
End Sub
 
 
Sub ChargerLesMatrices()
 
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
Dim AireRegion As Excel.Range, AireDep As Excel.Range, AireVilles As Excel.Range, AireCodes As Excel.Range
 
 
        On Error GoTo Fin:
 
        Chemin = ActiveDocument.Path & "\Base de données.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
             Set AireRegion = .ListObjects("TableRegions").DataBodyRange
 
             ReDim MatriceRegions(AireRegion.Count - 1)
             For J = 1 To AireRegion.Count
                 MatriceRegions(J - 1) = AireRegion(J).Value
             Next J
 
             Set AireDep = .ListObjects("TableDep").ListColumns(1).DataBodyRange
             ReDim MatriceDep(AireDep.Count - 1, 1)
             For J = 1 To AireDep.Count
                 MatriceDep(J - 1, 0) = AireDep(J).Value
                 MatriceDep(J - 1, 1) = AireDep(J).Offset(0, 1).Value
             Next J
 
             Set AireVilles = .ListObjects("TableVilles").ListColumns(1).DataBodyRange
             ReDim MatriceVilles(AireVilles.Count - 1, 1)
             For J = 1 To AireVilles.Count
                 MatriceVilles(J - 1, 0) = AireVilles(J).Value
                 MatriceVilles(J - 1, 1) = AireVilles(J).Offset(0, 1).Value
             Next J
 
             Set AireCodes = .ListObjects("TableDesCodes").ListColumns(1).DataBodyRange
             ReDim MatriceCodes(AireCodes.Count - 1, 3)
             For J = 1 To AireCodes.Count
                 MatriceCodes(J - 1, 0) = AireCodes(J).Value
                 MatriceCodes(J - 1, 1) = AireCodes(J).Offset(0, 1).Value
                 MatriceCodes(J - 1, 2) = AireCodes(J).Offset(0, 2).Value
                 MatriceCodes(J - 1, 3) = AireCodes(J).Offset(0, 3).Value
             Next J
 
        End With
 
        GoTo Fin:
 
Fin:
 
        xlWb.Close savechanges:=False
        xlApp.Quit
 
        Set AireRegion = Nothing
        Set AireDep = Nothing
        Set AireVilles = Nothing
        Set AireCodes = Nothing
        Set xlWs = Nothing
        Set xlWb = Nothing
        Set xlApp = Nothing
 
End Sub

Dans ThisDocument :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
 
Private Sub Document_Open()
 
      LancerLaBoiteDeDialogue
 
End Sub

A l'ouverture du document, la boite de dialogue donnerait cela :

Pièce jointe 574828

Dans le module de la boite de dialogue :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Explicit
 
 
Private Sub ComboBoxRegions_Change()
 
Dim I As Long
 
        Me.ComboBoxDep.Clear
        Me.ComboBoxVilles.Clear
        Me.ComboBoxCodes.Clear
 
        For I = LBound(MatriceDep, 1) To UBound(MatriceDep, 1)
            If MatriceDep(I, 0) = Me.ComboBoxRegions.Value Then
               ComboBoxDep.AddItem MatriceDep(I, 1)
            End If
        Next I
 
End Sub
 
 
Private Sub ComboBoxDep_Change()
 
Dim I As Long
 
        Me.ComboBoxVilles.Clear
        Me.ComboBoxCodes.Clear
 
        For I = LBound(MatriceVilles, 1) To UBound(MatriceVilles, 1)
            If CStr(MatriceVilles(I, 0)) = CStr(Me.ComboBoxDep.Value) Then
               ComboBoxVilles.AddItem MatriceVilles(I, 1)
            End If
        Next I
 
End Sub
 
Private Sub ComboBoxVilles_Change()
 
Dim I As Long
 
        Me.ComboBoxCodes.Clear
 
        For I = LBound(MatriceCodes, 1) To UBound(MatriceCodes, 1)
            If CStr(MatriceCodes(I, 1)) = CStr(Me.ComboBoxDep.Value) And MatriceCodes(I, 2) = Me.ComboBoxVilles.Value Then
               ComboBoxCodes.AddItem MatriceCodes(I, 3)
            End If
        Next I
 
End Sub