MAcro Ouvrir un fichier excel avec un "tri"

FrancoisC43212

XLDnaute Nouveau
Bonjour, je pense que le titre n'est pas clair (pas trouvé mieux) donc je m'explique:

J'ai fais une macro qui me permet d'ouvrir un fichier excel. Jusque là tout va bien.
En revanche pour éviter les erreurs de sélection je souhaite créer une procédure pour ne sélectionner que les classeurs qui contiennent des mots clés définis. Ici "Portefeuille" et "Février"

Pour l'instant avec ma macro n'importe qu'elle fichier, j'aimerais donc qu'elle me tri et affiche directement les fichier avec les mots "portefeuille" et "février"(ou un autre mois^^)

Voilà la macro

(Vous l'aurez surement compris, je débute dans vba)

Code:
Dim wbMyWb As Workbook
Dim Nom_Fichier As Variant
Dim Nom_Feuille As Variant

Nom_Fichier = Application.GetOpenFilename("Fichiers Excel  (*.xlsx), *.xlsm")
If Nom_Fichier <> False Then
   Set wbMyWb = Workbooks.Open(Nom_Fichier)
  wbMyWb.Activate
End If

Merci beaucoup !
 

job75

XLDnaute Barbatruc
Bonjour FrancoisC43212, bienvenue sur XLD,

Application.GetOpenFilename est utilisé pour vous permettre de choisir le fichier.

Si vous voulez qu'Excel fasse ce choix à votre place n'utilisez pas cette [Edit] méthode.

Mettez les critères de choix dans des cellules et filtrez en utilisant la fonction Dir.

Nombreux exemples sur le forum.

Bonne journée.
 
Dernière édition:

Robert

XLDnaute Barbatruc
Repose en paix
Bonjour François, bonjour le forum,

En pièce jointe une proposition avec une UserForm...
Le code :

VB:
Private M As String 'déclare la variable M (Mois)
Private CA As String 'déclare la variabe CA (Chemin d'Accès)

Private Sub UserForm_Initialize() 'à l'initialisation de l'UserForm
Dim TM As Variant 'déclare la variable TM (Tableau des Mois)
Dim I As Byte 'déclare la variable I (Incrément)

TM = Array("Janvier", "Février", "Mars", "Avril", "Mai", "Juin", "Juillet", "Août", "Septembre", "Octobre", "Novembre", "Décembre") 'définit le tableau des Mois TM
For I = LBound(TM) To UBound(TM) 'boucle sur tous les élément du tableau des mois
  Me.ComboBox1.AddItem TM(I) 'alimente la ComboBox1
Next I 'prochain élément de la boucle
End Sub

Private Sub ComboBox1_Change() 'au changement dans la ComboBox1
If Me.ComboBox1.ListIndex <> -1 Then M = Me.ComboBox1.Value Else M = "" 'si l'élément fait partie de la liste, définit le mois M, sinon M est vide
End Sub

Private Sub CommandButton1_Click() 'bouton Dossier de recherche
Dim FD As FileDialog 'déclare la variable FD (FileDialog)
Dim F As String 'déclare la variable F (Fichier)

If M = "" Then 'condition si M est vide
  MsgBox "Vous devez choisir un mois !" 'message
  With Me.ComboBox1 'prend en compte la ComboBox1
  .SetFocus 'place le curseur
  .SelStart = 0 'sélection, début de la sélection
  .SelLength = Len(.Value) 'sélection, longueur de la sélection
  End With 'fin de la prise en compte de la ComboBox1
  Exit Sub 'sort de la procédure
End If 'fin de la condition

Set FD = Application.FileDialog(msoFileDialogFolderPicker) 'définit la variable FD
With FD 'prend en compte la variable FB
  .InitialFileName = "C:\" 'dossier de départ (à adapter)
  If .Show = -1 Then If .SelectedItems(1) <> "" Then CA = .SelectedItems(1) & "\" 'si un dossier est sélectionné, définit le chemin d accès CA
End With 'fin de la prise en compte  de la variable FD
F = Dir(CA & "\*.xlsx") 'définit le premier fichier F ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant qu'il existe des fichier
  If InStr(1, F, "Portefeuille", vbTextCompare) <> 0 Then 'condition 1 : si le nom du fichier contien le mot "Portefeuille"
  If InStr(1, F, M, vbTextCompare) <> 0 Then 'condition 2 : si le nom du fichier contient le mois M
  Me.ListBox1.AddItem F 'alimente la ListBox1 avec le nom du fichier
  End If 'fin de la condition 2
  End If 'fin de la condition 1
  F = Dir 'définit le prochain fichier ayant CA comme chemin d'accès
Loop 'boucle
F = Dir(CA & "\*.xlsm") 'définit le premier fichier F ayant CA comme chemin d'accès
Do While F <> "" 'boucle tant qu'il existe des fichier
  If InStr(1, F, "Portefeuille", vbTextCompare) <> 0 Then 'condition 1 : si le nom du fichier contien le mot "Portefeuille"
  If InStr(1, F, M, vbTextCompare) <> 0 Then 'condition 2 : si le nom du fichier contient le mois M
  Me.ListBox1.AddItem F 'alimente la ListBox1 avec le nom du fichier
  End If 'fin de la condition 2
  End If 'fin de la condition 1
  F = Dir 'définit le prochain fichier ayant CA comme chemin d'accès
Loop 'boucle
If Me.ListBox1.ListCount = 0 Then 'condition : si la ListBox1 est vide
  MsgBox "Aucun fichier trouvé !" 'message
  Unload Me 'vide et ferme l'UserForm en cours
End If 'fin de la condition
End Sub

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) 'au double-clic dans la la ListBox1
Application.Workbooks.Open (CA & Me.ListBox1.Value) 'ouvre le fichier double-cliqué
Unload Me 'vide et ferme l'UserForm en cours
End Sub

[Édition]
Bonjour Job, nos posts se sont croisés...
 

Pièces jointes

  • Francois_ED_v01.xlsm
    27 KB · Affichages: 12

job75

XLDnaute Barbatruc
Bonjour FrancoisC43212, Robert,

Une autre solution, sans UserForm :
Code:
Private Sub Label1_Click()
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "DOSSIER A ETUDIER"
    If Not .Show Then Exit Sub
    [C3] = .SelectedItems(1)
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [C3:E3]) Is Nothing Then Exit Sub
Dim lig$, chemin$, fichier$
lig = 5 'ère ligne de restitution
If [C3] <> "" Then
    chemin = [C3] & "\"
    fichier = Dir(chemin & "*" & [D3] & "*" & [E3] & "*") '1er fichierdu dossier
    While fichier <> ""
        Hyperlinks.Add Cells(lig, 3), chemin & fichier 'lien hypertexte
        lig = lig + 1
        fichier = Dir 'fichier suivant
    Wend
End If
Range("C" & lig & ":C" & Rows.Count).Delete xlUp 'RAZ en dessous
End Sub
Fichiers zippés joints.

A+
 

Pièces jointes

  • Recherche fichier(1).zip
    56.2 KB · Affichages: 13

Discussions similaires

Réponses
1
Affichages
121

Statistiques des forums

Discussions
311 729
Messages
2 081 971
Membres
101 852
dernier inscrit
dthi16088