Re : Menus en cascades contenus dans Excel et affichés sous Word
Bonsoir le Forum, bonsoir Tatiak
J'ai comme prévu essayé dès ce soir la transposition à mes données réelles.
ça c'est pas mal passé, à deux exceptions près :
J'ai changé mes étiquettes de colonnes dans ma base de donnée excel, comme ceci :
Métiers Domaines Sous_Domaines Activités Savoirs_SF
J'ai ajouté une cinquième colonne et par conséquent une 5eme combobox dans mon document Word.
Sous Word, j'ai modifié les deux scripts comme ceci :
Pour le Script "ThisDocument"
Option Explicit
Private Sub Document_Open()
Dim lig As Integer, i As Integer
With ActiveDocument
lig = Get_List_Métiers
If lig > 0 Then
For i = 0 To lig - 1
.ComboBox1.AddItem RcdSt(0, i)
Next i
.ComboBox1.ListIndex = -1
.ComboBox2.Clear
.ComboBox2.ListIndex = -1
.ComboBox3.Clear
.ComboBox3.ListIndex = -1
.ComboBox4.Clear
.ComboBox4.ListIndex = -1
.ComboBox5.Clear
.ComboBox5.ListIndex = -1
End If
End With
End Sub
Private Sub ComboBox1_Change()
Dim lig As Integer, i As Integer
With ActiveDocument
.ComboBox2.Clear
lig = Get_List_Domaines(.ComboBox1.Value)
If lig > 0 Then
For i = 0 To lig - 1
.ComboBox2.AddItem RcdSt(0, i)
Next i
.ComboBox2.ListIndex = -1
.ComboBox3.Clear
.ComboBox3.ListIndex = -1
.ComboBox4.Clear
.ComboBox4.ListIndex = -1
.ComboBox5.Clear
.ComboBox5.ListIndex = -1
End If
End With
End Sub
Private Sub ComboBox2_Change()
Dim lig As Integer, i As Integer
With ActiveDocument
.ComboBox3.Clear
lig = Get_List_Sous_Domaines(.ComboBox1.Value, .ComboBox2.Value)
If lig > 0 Then
For i = 0 To lig - 1
.ComboBox3.AddItem RcdSt(0, i)
Next i
.ComboBox3.ListIndex = -1
.ComboBox4.Clear
.ComboBox4.ListIndex = -1
.ComboBox5.Clear
.ComboBox5.ListIndex = -1
End If
End With
End Sub
Private Sub ComboBox3_Change()
Dim lig As Integer, i As Integer
With ActiveDocument
.ComboBox4.Clear
lig = Get_List_Activités(.ComboBox1.Value, .ComboBox2.Value, .ComboBox3.Value)
If lig > 0 Then
For i = 0 To lig - 1
.ComboBox4.AddItem RcdSt(0, i)
Next i
.ComboBox4.ListIndex = -1
.ComboBox5.Clear
.ComboBox5.ListIndex = -1
End If
End With
End Sub
Private Sub ComboBox4_Change()
Dim lig As Integer, i As Integer
With ActiveDocument
.ComboBox5.Clear
lig = Get_List_Savoirs_SF(.ComboBox1.Value, .ComboBox2.Value, .ComboBox3.Value, .ComboBox4.Value)
If lig > 0 Then
For i = 0 To lig - 1
.ComboBox5.AddItem RcdSt(0, i)
Next i
.ComboBox5.ListIndex = -1
End If
End With
End Sub
Pour le script "SQL"
Option Explicit
Public Const adOpenStatic = 3
Public Const adStateOpen = 1
Public Head() As Variant
Public RcdSt() As Variant
' Fichier données
Public Const NDF = "BDD.xlsx"
Public Const Data = "BD"
' ***** REQUETES **********************************************************************************
Function Get_List_Métiers() As Integer
Dim Requete As String
Requete = "SELECT Métiers FROM [" & Data & "$] GROUP BY Métiers ORDER BY Métiers"
Get_List_Métiers = SQL.Query(Requete, ActiveDocument.Path & "\" & NDF)
End Function
Function Get_List_Domaines(Métiers As String) As Integer
Dim Requete As String
Requete = "SELECT Domaines FROM [" & Data & "$] " & _
" WHERE Métiers='" & Métiers & "'" & _
" GROUP BY Domaines ORDER BY Domaines"
Get_List_Domaines = SQL.Query(Requete, ActiveDocument.Path & "\" & NDF)
End Function
Function Get_List_Sous_Domaines(Métiers As String, Domaines As String) As Integer
Dim Requete As String
Requete = "SELECT Sous_Domaines FROM [" & Data & "$] " & _
" WHERE Métiers='" & Métiers & "'" & _
" AND Domaines='" & Domaines & "'" & _
" GROUP BY Sous_Domaines ORDER BY Sous_Domaines"
Get_List_Sous_Domaines = SQL.Query(Requete, ActiveDocument.Path & "\" & NDF)
End Function
Function Get_List_Activités(Métiers As String, Domaines As String, Sous_Domaines As String) As Integer
Dim Requete As String
Requete = "SELECT Activités FROM [" & Data & "$] " & _
" WHERE Métiers='" & Métiers & "'" & _
" AND Domaines='" & Domaines & "'" & _
" AND Sous_Domaines='" & Sous_Domaines & "'" & _
" GROUP BY Activités ORDER BY Activités"
Get_List_Activités = SQL.Query(Requete, ActiveDocument.Path & "\" & NDF)
End Function
Function Get_List_Savoirs_SF(Métiers As String, Domaines As String, Sous_Domaines As String, Activités As String) As Integer
Dim Requete As String
Requete = "SELECT Savoirs_SF FROM [" & Data & "$] " & _
" WHERE Métiers='" & Métiers & "'" & _
" AND Domaines='" & Domaines & "'" & _
" AND Sous_Domaines='" & Sous_Domaines & "'" & _
" AND Activités='" & Activités & "'" & _
" GROUP BY Savoirs_SF ORDER BY Savoirs_SF"
Get_List_Savoirs_SF = SQL.Query(Requete, ActiveDocument.Path & "\" & NDF)
End Function
' ***** REQUETEUR SQL *****************************************************************************
Function Query(Requete As String, NDF_Data As String) As Variant
Dim Cnx As Object ' ADODB.Connection
Dim Rst As Object ' ADODB.Recordset
Dim Col_SQL As Integer, i As Integer
On Error GoTo errhdlr
Set Cnx = CreateObject("ADODB.Connection") ' = New ADODB.Connection
With Cnx
.Provider = "MSDASQL"
.ConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & NDF_Data & "; ReadOnly=False"
.Open
End With
Set Rst = CreateObject("ADODB.Recordset") ' = New ADODB.Recordset
If Left(Requete, 6) = "SELECT" Then
Rst.Open Requete, Cnx, adOpenStatic
Query = Rst.RecordCount
Col_SQL = Rst.Fields.Count - 1
If Not Query = 0 Then
ReDim Head(Col_SQL)
For i = 0 To Col_SQL
Head(i) = Rst.Fields(i).Name
Next i
ReDim RcdSt(Col_SQL, Query)
Rst.MoveFirst
RcdSt = Rst.GetRows
End If
Else
Query = 1
Set Rst = Cnx.Execute(Requete)
End If
Cnx.Close
Set Cnx = Nothing
Set Rst = Nothing
Exit Function
errhdlr:
If Not Rst Is Nothing Then
If Rst.State = adStateOpen Then Rst.Close
End If
Set Rst = Nothing
If Not Cnx Is Nothing Then
If Cnx.State = adStateOpen Then Cnx.Close
End If
Set Cnx = Nothing
MsgBox (Err.Description & vbCrLf & vbCrLf & "Vérifier la requête (ou son appel) : " & vbCrLf & Requete)
End Function
Résultats :
- La 5eme combobox n'est jamais alimentée
- D'autre part, lors de certaines selections (j'ai refait le tests à plusieurs reprises sur les mêmes données) une des combobox n'est pas alimentée (ça peut être la 2 ou la 3) et le message suivant m'est retourné : Pilote ODBC Excel Erreur de syntaxe (opérateur absent) dans l'expression ....Vérifier la requete (ou son appel) .....
Ma BDD comporte plus de 5000 lignes, ceci explique-t-il cela ?
Je n'ai volontairement pas remis la BDD en P.J. pour cause de confidentialité, si ceci s'avérait nécessaire, je pourrais en mettre un nouvel échantillon maquillé.
Merci à nouveau pour ton aide précieuse et très bonne soirée à tous.
