Microsoft 365 Userform filtre listbox
- Initiateur de la discussion lesoldat9
- Date de début
-
- Mots-clés
- filtre listbox
Solution
Du coup, qu'est ce que t'as fais ? car je dois modifier mon vrai fichier...
fanch55
XLDnaute Barbatruc
Fonction Get_Fields corrigée
j'ai a peu près compris mais ca ne fonctionne toujours pas chez moi
fanch55
XLDnaute Barbatruc
Le code ci-dessous va afficher le fichier supposé de ton classeur,
Peux tu me dire ce qu'il affiche ? ( nota: je suis absent ce jeudi après-midi )
Peux tu me dire ce qu'il affiche ? ( nota: je suis absent ce jeudi après-midi )
VB:
Public Function Get_Fields( _
Target As Variant, _
ByVal Select_String As String, _
Optional ByVal Select_Base As String, _
Optional Header As Boolean = False, _
Optional Column_Widths As String = "-1") As Boolean
Dim Base As Object
Dim Requete As Object
If InStr(1, ThisWorkbook.FullName, "https:", vbTextCompare) Then
Fname = Environ("OneDrive")
T = Split(ThisWorkbook.FullName, "/")
For i = 4 To UBound(T)
Fname = Fname & "\" & T(i)
Next
Else
Fname = ThisWorkbook.FullName
End If
MsgBox "Fname=" & Fname
Sql_Driver = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & Fname & ";READONLY=FALSE"
If Select_Base = "" Then Select_Base = Sql_Driver
On Error Resume Next
Set Base = CreateObject("ADODB.Connection")
Base.CursorLocation = 3 ' ne pas utiliser adUseClient ou adUseServer sinon renseigner les références vb
Base.Open Select_Base
Set Requete = CreateObject("ADODB.recordset")
Requete.Open Select_String, Base
Select Case True
Case Err <> 0
Get_Fields = False
MsgBox "Erreur " & Err().Number & vbLf & Err().Description
Case Requete.State = 0 ' Fermé <-- Update ou insert ou delete ( pas de retour ) "
Get_Fields = True
Case Requete.RecordCount = 0
Get_Fields = False
Case Else
Get_Fields = True
Select Case TypeName(Target)
Case "ListBox", "ComboBox" ' Retour dans une Listbox
With Target
.Clear
.ColumnCount = Requete.Fields.Count
.ColumnWidths = Column_Widths
.Column = Requete.GetRows
End With
Case "Range" ' une plage de cellules ou tableau excel
If Target.ListObject Is Nothing Then
If Header Then
For i = 0 To Requete.Fields.Count - 1
Cells(Target.Row, Target.Column + i).Value = Requete.Fields(i).Name
Cells(Target.Row, Target.Column + i).Interior.Color = 13553360
Cells(Target.Row, Target.Column + i).Borders.LineStyle = xlDouble
Next
Set Target = Target.Offset(1)
End If
Else
If Not Target.ListObject.DataBodyRange Is Nothing _
Then Target.ListObject.DataBodyRange.Delete
End If
Target.CopyFromRecordset Requete
Case Else ' Retour dans une variable tableau
Target = Requete.GetRows
End Select
End Select
If Requete.State > 0 Then Requete.Close
Set Requete = Nothing
Base.Close
Set Base = Nothing
End Function
Dernière édition:
Bonjour
Désolé pour ce retour tardif j'avais pas vu ton retour.
ci joint ce que la formule affiche.
Désolé pour ce retour tardif j'avais pas vu ton retour.
ci joint ce que la formule affiche.
Pièces jointes
fanch55
XLDnaute Barbatruc
Ok,
Peux-tu exécuter ce bout de code dans ton vbe et me dire ce qu'il affiche ?
Si rien n'est affiché, c'est que ce n'est pas un serveur Onedrive mais un Sharepoint online et là il faudra trouver une autre solution avec quelqu'un d'autre car je ne suis pas sous office 365 .
Peux-tu exécuter ce bout de code dans ton vbe et me dire ce qu'il affiche ?
VB:
Sub OneFolder()
Msgbox ">>" & Environ("Onedrive") & "<<"
End subSi rien n'est affiché, c'est que ce n'est pas un serveur Onedrive mais un Sharepoint online et là il faudra trouver une autre solution avec quelqu'un d'autre car je ne suis pas sous office 365 .
Dernière édition:
fanch55
XLDnaute Barbatruc
Ci_joint le classeur revisité pour ne plus employer Ado,
il devrait fonctionner sur Sharepoint .
il devrait fonctionner sur Sharepoint .
Discussions similaires
- Résolu(e)
