Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Applications Microsoft Office Excel Barre liste des fichier d'Hervé

Barre liste des fichier d'Hervé

5 réponses
Avatar
Gaspareau
Bonjour,

J'ai récupéré sur Excelabo ce code qu'Hervé a gentillement rendu disponible.
Ce code lorsqu'exécuté crée une barre avec une liste complète des fichiers
Excl
d'un répertoire donné.
Ma question: Est-ce possible de faire en sorte qu'il puisse ouvrir un
fichier même
si celui-ci n'est pas à la racine du répertoire mentionné.

J'ai essayé et si mon fichier est à la racine il ouvre mais si je met la
condition
.SearchSubFolders = True, j'ai la liste de tous les fichiers mais ceux-ci
ne s'ouvre pas
lorsque je clique dessus.

C'est faisable ou je rêve ???

Merci


Sub NouvelleBarre()
Dim Barre As CommandBar
Dim Cmb As CommandBarComboBox
Dim Rf As FileSearch
Dim Tbl() As String
Dim Dossier As String
Dim I As Integer
On Error Resume Next
Application.CommandBars("MaBarre").Delete
Set Rf = Application.FileSearch
Dossier = "F:\Flo\Nouveau dossier\" 'Indiquez ici le chemin du dossier
With Rf
.NewSearch
.Filename = "*.xls"
.LookIn = Dossier
.SearchSubFolders = False 'True pour les sous-dossiers
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
ReDim Preserve Tbl(1 To I)
Tbl(I) = Dir(.Item(I))
Next I
End With
End If
End With
Set Barre = Application.CommandBars.Add _
("MaBarre", msoBarTop, False, True)
With Barre
Set Cmb = .Controls.Add(msoControlComboBox)
With Cmb
.Caption = "MonCombo"
.Width = 200
.OnAction = "LaMacro"
If Right(Dossier, 1) <> "\" Then Dossier = Dossier & "\"
.Tag = Dossier
.TooltipText = "Ouvre le classeur !"
If I <> 0 Then
For I = 1 To UBound(Tbl)
.AddItem Tbl(I)
Next I
Else
.AddItem "Aucun classeur"
End If
.ListIndex = 1
End With
.Visible = True
End With
Set Cmb = Nothing
Set Barre = Nothing
Set Rf = Nothing
Erase Tbl
End Sub

Sub LaMacro()
Dim NomClasseur As String
With CommandBars.ActionControl
NomClasseur = .List(.ListIndex)
MsgBox NomClasseur
If NomClasseur = "Aucun classeur" Then
MsgBox "Aucun classeur n'a été" & _
" trouvé dans le dossier " & .Tag
Exit Sub
End If
MsgBox .Tag & NomClasseur
On Error Resume Next
Workbooks(NomClasseur).Activate
If Err.Number <> 0 Then
Workbooks.Open .Tag & NomClasseur
End If
End With
End Sub
Signaler un problème avec ce contenu

5 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
michdenis
Bonjour Gaspareau,

C'est faisable ou je rêve ??? Les 2 !!!

C'est faisaable ... le contraire serait surprenant

tu rêves : Si tu crois que je vais fouiller sur Excelabo pour tenter de trouver la procédure à Hervé !



Salutations!




"Gaspareau" a écrit dans le message de news:
Bonjour,

J'ai récupéré sur Excelabo ce code qu'Hervé a gentillement rendu disponible.
Ce code lorsqu'exécuté crée une barre avec une liste complète des fichiers
Excl
d'un répertoire donné.
Ma question: Est-ce possible de faire en sorte qu'il puisse ouvrir un
fichier même
si celui-ci n'est pas à la racine du répertoire mentionné.

J'ai essayé et si mon fichier est à la racine il ouvre mais si je met la
condition
.SearchSubFolders = True, j'ai la liste de tous les fichiers mais ceux-ci
ne s'ouvre pas
lorsque je clique dessus.

C'est faisable ou je rêve ???

Merci


Sub NouvelleBarre()
Dim Barre As CommandBar
Dim Cmb As CommandBarComboBox
Dim Rf As FileSearch
Dim Tbl() As String
Dim Dossier As String
Dim I As Integer
On Error Resume Next
Application.CommandBars("MaBarre").Delete
Set Rf = Application.FileSearch
Dossier = "F:FloNouveau dossier" 'Indiquez ici le chemin du dossier
With Rf
.NewSearch
.Filename = "*.xls"
.LookIn = Dossier
.SearchSubFolders = False 'True pour les sous-dossiers
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
ReDim Preserve Tbl(1 To I)
Tbl(I) = Dir(.Item(I))
Next I
End With
End If
End With
Set Barre = Application.CommandBars.Add _
("MaBarre", msoBarTop, False, True)
With Barre
Set Cmb = .Controls.Add(msoControlComboBox)
With Cmb
.Caption = "MonCombo"
.Width = 200
.OnAction = "LaMacro"
If Right(Dossier, 1) <> "" Then Dossier = Dossier & ""
.Tag = Dossier
.TooltipText = "Ouvre le classeur !"
If I <> 0 Then
For I = 1 To UBound(Tbl)
.AddItem Tbl(I)
Next I
Else
.AddItem "Aucun classeur"
End If
.ListIndex = 1
End With
.Visible = True
End With
Set Cmb = Nothing
Set Barre = Nothing
Set Rf = Nothing
Erase Tbl
End Sub

Sub LaMacro()
Dim NomClasseur As String
With CommandBars.ActionControl
NomClasseur = .List(.ListIndex)
MsgBox NomClasseur
If NomClasseur = "Aucun classeur" Then
MsgBox "Aucun classeur n'a été" & _
" trouvé dans le dossier " & .Tag
Exit Sub
End If
MsgBox .Tag & NomClasseur
On Error Resume Next
Workbooks(NomClasseur).Activate
If Err.Number <> 0 Then
Workbooks.Open .Tag & NomClasseur
End If
End With
End Sub
Avatar
Gaspareau
Bonjour et merci

merci tout de même car la procédure elle est toute là
juste à descendre dans le message que j'ai posté


"michdenis" a écrit dans le message de
news:
Bonjour Gaspareau,

C'est faisable ou je rêve ??? Les 2 !!!

C'est faisaable ... le contraire serait surprenant

tu rêves : Si tu crois que je vais fouiller sur Excelabo pour tenter de
trouver la procédure à Hervé !




Salutations!




"Gaspareau" a écrit dans le message de
news:

Bonjour,

J'ai récupéré sur Excelabo ce code qu'Hervé a gentillement rendu
disponible.

Ce code lorsqu'exécuté crée une barre avec une liste complète des fichiers
Excl
d'un répertoire donné.
Ma question: Est-ce possible de faire en sorte qu'il puisse ouvrir un
fichier même
si celui-ci n'est pas à la racine du répertoire mentionné.

J'ai essayé et si mon fichier est à la racine il ouvre mais si je met la
condition
.SearchSubFolders = True, j'ai la liste de tous les fichiers mais ceux-ci
ne s'ouvre pas
lorsque je clique dessus.

C'est faisable ou je rêve ???

Merci


Sub NouvelleBarre()
Dim Barre As CommandBar
Dim Cmb As CommandBarComboBox
Dim Rf As FileSearch
Dim Tbl() As String
Dim Dossier As String
Dim I As Integer
On Error Resume Next
Application.CommandBars("MaBarre").Delete
Set Rf = Application.FileSearch
Dossier = "F:FloNouveau dossier" 'Indiquez ici le chemin du dossier
With Rf
.NewSearch
.Filename = "*.xls"
.LookIn = Dossier
.SearchSubFolders = False 'True pour les sous-dossiers
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
ReDim Preserve Tbl(1 To I)
Tbl(I) = Dir(.Item(I))
Next I
End With
End If
End With
Set Barre = Application.CommandBars.Add _
("MaBarre", msoBarTop, False, True)
With Barre
Set Cmb = .Controls.Add(msoControlComboBox)
With Cmb
.Caption = "MonCombo"
.Width = 200
.OnAction = "LaMacro"
If Right(Dossier, 1) <> "" Then Dossier = Dossier & ""
.Tag = Dossier
.TooltipText = "Ouvre le classeur !"
If I <> 0 Then
For I = 1 To UBound(Tbl)
.AddItem Tbl(I)
Next I
Else
.AddItem "Aucun classeur"
End If
.ListIndex = 1
End With
.Visible = True
End With
Set Cmb = Nothing
Set Barre = Nothing
Set Rf = Nothing
Erase Tbl
End Sub

Sub LaMacro()
Dim NomClasseur As String
With CommandBars.ActionControl
NomClasseur = .List(.ListIndex)
MsgBox NomClasseur
If NomClasseur = "Aucun classeur" Then
MsgBox "Aucun classeur n'a été" & _
" trouvé dans le dossier " & .Tag
Exit Sub
End If
MsgBox .Tag & NomClasseur
On Error Resume Next
Workbooks(NomClasseur).Activate
If Err.Number <> 0 Then
Workbooks.Open .Tag & NomClasseur
End If
End With
End Sub






Avatar
michdenis
Bonjour Gaspareau,


Désolé, je n'avais pas vu la procédure dans le bas de ton message.


La problématique est lorsque tu utilises cette propriété comme ceci : SearchSubFolders = True , cela va inclure tous les
fichiers de tous les sous-répertoires. Le Hic est comment conservé le "CHEMIN" associé à chaque fichier car lorsque tu ouvres
le fichier, tu as besoin non seulement du nom du fichier que tu as mis dans le combobox mais aussi du chemin où se situe le
fichier.

Une possibilité serait d'entreposer tous les chemins et fichiers dans une feuille masquée :
Colonne A : enregistrement des chemins
Colonne B : Enregistrement du fichier associé au chemin en colonne A

Dans un deuxième temps, tu utilises la liste de la colonne B pour afficher dans ton combobox

Dans un troisième temps, lorsque tu cliques sur un fichier dans le combobox, tu fais une recherche dans la colonne B de la
feuille afin de retrouver le chemin associé En colonne A ...après avoir trouvé le chemin et le fichier... ouvrir ce fichier
est une tâche simple.

Évidemment, il reste à transformer ton code ....je n'ai pas le temps pour l'instant ... !



Salutations!







"Gaspareau" a écrit dans le message de news:
Bonjour et merci

merci tout de même car la procédure elle est toute là
juste à descendre dans le message que j'ai posté


"michdenis" a écrit dans le message de
news:
Bonjour Gaspareau,

C'est faisable ou je rêve ??? Les 2 !!!

C'est faisaable ... le contraire serait surprenant

tu rêves : Si tu crois que je vais fouiller sur Excelabo pour tenter de
trouver la procédure à Hervé !




Salutations!




"Gaspareau" a écrit dans le message de
news:

Bonjour,

J'ai récupéré sur Excelabo ce code qu'Hervé a gentillement rendu
disponible.

Ce code lorsqu'exécuté crée une barre avec une liste complète des fichiers
Excl
d'un répertoire donné.
Ma question: Est-ce possible de faire en sorte qu'il puisse ouvrir un
fichier même
si celui-ci n'est pas à la racine du répertoire mentionné.

J'ai essayé et si mon fichier est à la racine il ouvre mais si je met la
condition
.SearchSubFolders = True, j'ai la liste de tous les fichiers mais ceux-ci
ne s'ouvre pas
lorsque je clique dessus.

C'est faisable ou je rêve ???

Merci


Sub NouvelleBarre()
Dim Barre As CommandBar
Dim Cmb As CommandBarComboBox
Dim Rf As FileSearch
Dim Tbl() As String
Dim Dossier As String
Dim I As Integer
On Error Resume Next
Application.CommandBars("MaBarre").Delete
Set Rf = Application.FileSearch
Dossier = "F:FloNouveau dossier" 'Indiquez ici le chemin du dossier
With Rf
.NewSearch
.Filename = "*.xls"
.LookIn = Dossier
.SearchSubFolders = False 'True pour les sous-dossiers
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
ReDim Preserve Tbl(1 To I)
Tbl(I) = Dir(.Item(I))
Next I
End With
End If
End With
Set Barre = Application.CommandBars.Add _
("MaBarre", msoBarTop, False, True)
With Barre
Set Cmb = .Controls.Add(msoControlComboBox)
With Cmb
.Caption = "MonCombo"
.Width = 200
.OnAction = "LaMacro"
If Right(Dossier, 1) <> "" Then Dossier = Dossier & ""
.Tag = Dossier
.TooltipText = "Ouvre le classeur !"
If I <> 0 Then
For I = 1 To UBound(Tbl)
.AddItem Tbl(I)
Next I
Else
.AddItem "Aucun classeur"
End If
.ListIndex = 1
End With
.Visible = True
End With
Set Cmb = Nothing
Set Barre = Nothing
Set Rf = Nothing
Erase Tbl
End Sub

Sub LaMacro()
Dim NomClasseur As String
With CommandBars.ActionControl
NomClasseur = .List(.ListIndex)
MsgBox NomClasseur
If NomClasseur = "Aucun classeur" Then
MsgBox "Aucun classeur n'a été" & _
" trouvé dans le dossier " & .Tag
Exit Sub
End If
MsgBox .Tag & NomClasseur
On Error Resume Next
Workbooks(NomClasseur).Activate
If Err.Number <> 0 Then
Workbooks.Open .Tag & NomClasseur
End If
End With
End Sub






Avatar
Alain CROS
Bonjour

En ajoutant une liste non visible qui contient le chemin.

Alain CROS

Sub NouvelleBarre()
Dim Barre As CommandBar
Dim Cmb As CommandBarComboBox
Dim CmbHiden As CommandBarComboBox
Dim Rf As FileSearch
Dim Tbl() As String
Dim Dossier As String
Dim I As Integer
On Error Resume Next
Application.CommandBars("MaBarre").Delete
Set Rf = Application.FileSearch
Dossier = "F:FloNouveau dossier" 'Indiquez ici le chemin du dossier
With Rf
.NewSearch
.Filename = "*.xls"
.LookIn = Dossier
.SearchSubFolders = True 'True pour les sous-dossiers
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
ReDim Preserve Tbl(1 To 2, 1 To I)
Tbl(2, I) = Dir(.Item(I))
Tbl(1, I) = Left$(.Item(I), Len(.Item(I)) - Len(Tbl(2, I)))
Next I
End With
End If
End With
Set Barre = Application.CommandBars.Add _
("MaBarre", msoBarTop, False, True)
With Barre
Set Cmb = .Controls.Add(msoControlComboBox)
Set CmbHiden = .Controls.Add(msoControlComboBox)
With Cmb
.Caption = "MonCombo"
.Width = 200
.OnAction = "LaMacro"
If Right(Dossier, 1) <> "" Then Dossier = Dossier & ""
.Tag = Dossier
.TooltipText = "Ouvre le classeur !"
If I <> 0 Then
For I = 1 To UBound(Tbl, 2)
.AddItem Tbl(2, I)
Next I
Else
.AddItem "Aucun classeur"
End If
.ListIndex = 1
End With
With CmbHiden
For I = 1 To UBound(Tbl, 2)
.AddItem Tbl(1, I)
Next I
.Tag = "Hide"
.Visible = False
End With
.Visible = True
End With
Set Cmb = Nothing
Set CmbHiden = Nothing
Set Barre = Nothing
Set Rf = Nothing
Erase Tbl
End Sub

Sub LaMacro()
Dim NomClasseur As String
With CommandBars.ActionControl
NomClasseur = .List(.ListIndex)
MsgBox NomClasseur
If NomClasseur = "Aucun classeur" Then
MsgBox "Aucun classeur n'a été" & _
" trouvé dans le dossier " & .Tag
Exit Sub
End If
MsgBox .Parent.FindControl(, , "Hide").List(.ListIndex) & NomClasseur
On Error Resume Next
Workbooks(NomClasseur).Activate
If Err.Number <> 0 Then
Workbooks.Open .Parent.FindControl(, , "Hide").List(.ListIndex) & NomClasseur
End If
End With
End Sub

Sub SupBarre()
On Error Resume Next
Application.CommandBars("MaBarre").Delete
End Sub


"Gaspareau" a écrit dans le message de news:
Bonjour,

J'ai récupéré sur Excelabo ce code qu'Hervé a gentillement rendu disponible.
Ce code lorsqu'exécuté crée une barre avec une liste complète des fichiers
Excl
d'un répertoire donné.
Ma question: Est-ce possible de faire en sorte qu'il puisse ouvrir un
fichier même
si celui-ci n'est pas à la racine du répertoire mentionné.

J'ai essayé et si mon fichier est à la racine il ouvre mais si je met la
condition
.SearchSubFolders = True, j'ai la liste de tous les fichiers mais ceux-ci
ne s'ouvre pas
lorsque je clique dessus.

C'est faisable ou je rêve ???

Merci


Avatar
Gaspareau
Merci beaucoup Alain

C'est exactement l'effet désiré !!!

Je suis bouche la bée


"Alain CROS" a écrit dans le message de
news:%
Bonjour

En ajoutant une liste non visible qui contient le chemin.

Alain CROS

Sub NouvelleBarre()
Dim Barre As CommandBar
Dim Cmb As CommandBarComboBox
Dim CmbHiden As CommandBarComboBox
Dim Rf As FileSearch
Dim Tbl() As String
Dim Dossier As String
Dim I As Integer
On Error Resume Next
Application.CommandBars("MaBarre").Delete
Set Rf = Application.FileSearch
Dossier = "F:FloNouveau dossier" 'Indiquez ici le chemin du
dossier

With Rf
.NewSearch
.Filename = "*.xls"
.LookIn = Dossier
.SearchSubFolders = True 'True pour les sous-dossiers
.Execute msoSortByFileName, msoSortOrderAscending
If .Execute > 0 Then
With .FoundFiles
For I = 1 To .Count
ReDim Preserve Tbl(1 To 2, 1 To I)
Tbl(2, I) = Dir(.Item(I))
Tbl(1, I) = Left$(.Item(I), Len(.Item(I)) - Len(Tbl(2,
I)))

Next I
End With
End If
End With
Set Barre = Application.CommandBars.Add _
("MaBarre", msoBarTop, False, True)
With Barre
Set Cmb = .Controls.Add(msoControlComboBox)
Set CmbHiden = .Controls.Add(msoControlComboBox)
With Cmb
.Caption = "MonCombo"
.Width = 200
.OnAction = "LaMacro"
If Right(Dossier, 1) <> "" Then Dossier = Dossier & ""
.Tag = Dossier
.TooltipText = "Ouvre le classeur !"
If I <> 0 Then
For I = 1 To UBound(Tbl, 2)
.AddItem Tbl(2, I)
Next I
Else
.AddItem "Aucun classeur"
End If
.ListIndex = 1
End With
With CmbHiden
For I = 1 To UBound(Tbl, 2)
.AddItem Tbl(1, I)
Next I
.Tag = "Hide"
.Visible = False
End With
.Visible = True
End With
Set Cmb = Nothing
Set CmbHiden = Nothing
Set Barre = Nothing
Set Rf = Nothing
Erase Tbl
End Sub

Sub LaMacro()
Dim NomClasseur As String
With CommandBars.ActionControl
NomClasseur = .List(.ListIndex)
MsgBox NomClasseur
If NomClasseur = "Aucun classeur" Then
MsgBox "Aucun classeur n'a été" & _
" trouvé dans le dossier " & .Tag
Exit Sub
End If
MsgBox .Parent.FindControl(, , "Hide").List(.ListIndex) &
NomClasseur

On Error Resume Next
Workbooks(NomClasseur).Activate
If Err.Number <> 0 Then
Workbooks.Open .Parent.FindControl(, ,
"Hide").List(.ListIndex) & NomClasseur

End If
End With
End Sub

Sub SupBarre()
On Error Resume Next
Application.CommandBars("MaBarre").Delete
End Sub


"Gaspareau" a écrit dans le message de news:


Bonjour,

J'ai récupéré sur Excelabo ce code qu'Hervé a gentillement rendu
disponible.


Ce code lorsqu'exécuté crée une barre avec une liste complète des
fichiers


Excl
d'un répertoire donné.
Ma question: Est-ce possible de faire en sorte qu'il puisse ouvrir un
fichier même
si celui-ci n'est pas à la racine du répertoire mentionné.

J'ai essayé et si mon fichier est à la racine il ouvre mais si je met la
condition
.SearchSubFolders = True, j'ai la liste de tous les fichiers mais
ceux-ci


ne s'ouvre pas
lorsque je clique dessus.

C'est faisable ou je rêve ???

Merci