Bonsoir tout le monde, voila j'ai une fonction VBA qui est supposee recuperer les installations correspondants a un nom d'etablissement qui a ete saisie dans la cellule passee en parametre a la fonction. Au niveau modelisation, un etablissement est donc compose de plusieurs installations. Puis je veux mettre ces installations recuperees dans une liste pour validation de donnee (un menu deroulant).
Or j'obtiens un bug quqnd j'essaie de lancer ma fonction, j'ai une fenetre avec seulement une croix rouge qui s'affiche, et avec rien de marque a l'interieur.
Voici le code de ma fonction :

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
Public Function getInstallationsFromEtab(cellEtab As Range)
 
On Error GoTo Err
 
Dim etab As String
etab = cellEtab.Value
 
 
Dim oWks As DAO.WorkSpace
Dim oDB As DAO.Database
 
Set oWks = DbEngine.CreateWorkSpace("monWorkspace", "admin", "", dbUseJet)
Set oDB = oWks.OpenDatabase("CheminDeMaBase")
LSQL = "SELECT Installations.nom FROM Etablissements, Installations WHERE Installations.etablissementId = Etablissements.etablissementId AND ((Etablissements.nomEtablissement = '" & etab & " ')); "
 
Set lrs = oDB.OpenRecordset(LSQL)
Dim listInstall As String
 
 
If Not IsEmpty(lrs) Then
 
    listInstall = lrs("nom")
    lrs.moveNext
 
    Do While lrs.EOF = False
        listInstall = listInstall & ", " & lrs("nom")
        lrs.moveNext
    Loop
 
Else
    listInstall = ""
End If
MsgBox "6"
    ActiveCell.Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, _
        AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=listInstall
        .IgnoreBlank = True9
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
 
ExitFunction:
    Exit Function
 
Err:
    MsgBox "erreur : " & Err.Description
    Resume ExitFunction
 
End Function
Si vous avez des solutions, je suis preneur !!
Merci d'avance