Microsoft 365 Rechercher un fichier dans dossier

pelerin65

XLDnaute Occasionnel
Bonjour le forum,

Dans mon travail, je travaille avec un fichier Excel lors de l'enregistrement.
La tournée se nomme comme ca "A0......" suivant la tournée du jour. Et plus d'une centaine de tournées, et ça me permets de travailler avec les notes de la même tournée passée
J'occupe deux soit soit le poste ou j'utilise ce fichier.
Nous sommes trois a travailler sur se poste
Je voudrais pourvoir créer une petit macro avec un imputbox avec une recherche par nom du fichier
Si le fichier existe, me propose de l'ouvrir via un msgbox
Si le fichier n'existe pas , me propose d'ouvrir le fichier de base via un msgbox aussi.

Je ne suis pas spécialiste vba je cherche beaucoup et j adapte mais la je suis dépassé.

J'avais trouvé une ébauche, donc je joint le fichier,
J'ai toujours une résultat nul. par msgbox "le fichier existe pas

et je n'arrive pas à avoir la proposition d'ouvrir le fichier de base

Je vous remercie d'avance de votre aide.

j'espère être clair et compréhensif
 

Pièces jointes

  • RECHERCHER FICHIER.xlsb
    25.1 KB · Affichages: 7

Hasco

XLDnaute Barbatruc
Repose en paix
Bonjour,

doublon
 

bouchard

XLDnaute Nouveau
Bonjour Pelerin65
voici un début de solution, à adapter...
VB:
Sub UneSolution()
chemin = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\04-Tournées Realisées\"
FichierDeBase = "MonFichierDeBase.xls"
nomF = InputBox("Saisir le nom du fichier sans extention", "Ouvrir fichier")
If nomF <> "" Then
    fichier = Dir(chemin & nomF & ".xls*")
    If Left(fichier, Len(nomF)) = nomF Then
        Set wb = Workbooks.Open(chemin & fichier)
     Else
        Set wb = Workbooks.Open(chemin & FichierDeBase)
    End If
 Else
    MsgBox ("Recherche annulée.")
End If
End Sub

Bon code
 

bouchard

XLDnaute Nouveau
bien sûr,
ça donnerait a peu près ceci
VB:
Sub UneSolution()
chemin = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\04-Tournées Realisées\"
FichierDeBase = "MonFichierDeBase.xls"
nomF = InputBox("Saisir le nom du fichier sans extention", "Ouvrir fichier")
If nomF <> "" Then
    fichier = Dir(chemin & nomF & ".xls*")
    If Left(fichier, Len(nomF)) = nomF Then
        vrep = MsgBox(fichier & " trouvé. ouvrir?", vbYesNo)
        If vrep = 6 Then
            Set wb = Workbooks.Open(chemin & fichier)
        End If
     Else
        vrep = MsgBox(fichier & " non trouvé. ouvrir fichier de base ?", vbYesNo)
        If vrep = 6 Then
            Set wb = Workbooks.Open(chemin & FichierDeBase)
        End If
    End If
 Else
    MsgBox ("Recherche annulée.")
End If
End Sub

plus tard ce serait de remplir une listbox avec tous les fichiers qui répondes aux critères et de le présenter dans un formulaire...

bon code
 

pelerin65

XLDnaute Occasionnel
bien sûr,
ça donnerait a peu près ceci
VB:
Sub UneSolution()
chemin = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\04-Tournées Realisées\"
FichierDeBase = "MonFichierDeBase.xls"
nomF = InputBox("Saisir le nom du fichier sans extention", "Ouvrir fichier")
If nomF <> "" Then
    fichier = Dir(chemin & nomF & ".xls*")
    If Left(fichier, Len(nomF)) = nomF Then
        vrep = MsgBox(fichier & " trouvé. ouvrir?", vbYesNo)
        If vrep = 6 Then
            Set wb = Workbooks.Open(chemin & fichier)
        End If
     Else
        vrep = MsgBox(fichier & " non trouvé. ouvrir fichier de base ?", vbYesNo)
        If vrep = 6 Then
            Set wb = Workbooks.Open(chemin & FichierDeBase)
        End If
    End If
 Else
    MsgBox ("Recherche annulée.")
End If
End Sub

plus tard ce serait de remplir une listbox avec tous les fichiers qui répondes aux critères et de le présenter dans un formulaire...

bon code
Bonsoir Bouchard,

Super Génial, :cool:
Je peux avancer sur mon projet,
J'espère ne plus te demander de l'aide
Merci encore
 

pelerin65

XLDnaute Occasionnel
bonjour le forum

j'ai réussi à adapter ton code,

voilà lorsque le fichier n'existe pas, il crée bien un fichier qui se renomme avec la cellule "G8"

mais lorsque le fichier existe, il l'ouvre mais là, il me fait une erreur (Ligne surlignée)

image
je me suis lancer une sur une idée en fessant beaucoup d'enregistrement de macro et de l'adaptation

mon idée est un fichier de recherche qui vérifie le Numéro de Tournée existe dans un dossier "Tournées réalisées"

oui, il n'ouvre le fichier et je peux travailler avec avec un onglet avec une archive des tournées précédents

non, il crée le fichier en le renommant au nom de la tournée en G8

et garde le fichier LOC NG 23 vierge qui se situe dans un autre dossier "Loc NG 2023"

et est il possible de vider les cellules "D8 à J8" sans effacer les formules


rechercher-fichier.zip (690.10 Ko)
Loc-ng-23.zip (1.26 Mo)
Dim chemin2 As String
Dim fichierDeBase As String
Dim nomF As String
Dim Fichier As String
Dim wb As Workbook
Dim VREP As String
' chemin des fichiers
chemin = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\04-Tournées Realisées\"
chemin2 = "C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\00-Projet Loc Ng\Projet Loc Ng 2023\01-Loc Ng 2023\"
fichierDeBase = "Loc NG 23.xlsb"
'nomF = InputBox("Saisir le nom du fichier sans extention", "Ouvrir fichier")
nomF = Sheets("Tableau de Bord").Range("G8") '<- adapter éventuellement le nom de la feuille
If nomF <> "" Then
Fichier = Dir(chemin & nomF & ".xlsb*")
If Left(Fichier, Len(nomF)) = nomF Then
VREP = MsgBox(Fichier & " Fichier existe. l'ouvrir?", vbYesNo)
If VREP = 6 Then
Set wb = Workbooks.Open(chemin & Fichier)
End If
Else
VREP = MsgBox(Fichier & " Fichier n'existe pas. Création du fichier ?", vbYesNo)
If VREP = 6 Then
Set wb = Workbooks.Open(chemin2 & fichierDeBase)
End If
End If
Else
MsgBox ("Recherche annulée.")
End If
End Sub
la ligne en gras est là l'erreur
merci d'avance
 
Dernière édition:

bouchard

XLDnaute Nouveau
Bonsoir,
je note une anomalie dans le code, mais ça vient de ma réponse précédente.
il fallait écrire
VREP = MsgBox( nomf & " n'existe pas. Création du fichier ?", vbYesNo).

pour l'erreur (1004 que l'on retrouve partout sans vouloir dire grand chose...)
je ne vois pas d'erreur dans le code, je pencherais plutôt pour une faute dans la chaine chemin2 & fichierDeBase.
Pour chasser le doute essayez de copier la chaine suivante (chemin2 & fichierDeBase) dans la rubrique adresse de l'explorateur de fichier,Windows, et validez

C:\Users\6810558F\OneDrive - SNCF\Documents\0-Loc Ng\00-Projet Loc Ng\Projet Loc Ng 2023\01-Loc Ng 2023\Loc NG 23.xlsb

s'il y a une erreur, c'est que la chaine est mal orthographiée, sinon je vois pas trop sans avoir l'environnement et les fichiers.

pour la deuxième demande, il n'est pas possible d'effacer le contenu des cellules en gardant les formules.
Une astuce serait de conditionner l'affichage par formule, exemple
par vba suite au traitement placer un 1 en K8 : ...range("K8")=1
et dans chaques cellules de D8 à J8 =si(K8<>1; LaFormule ;"")

bon code
 

bouchard

XLDnaute Nouveau
Bonsoir,
Quand vous dites ne fonctionne pas, je dois comprendre n'est pas activé. En effet la condition est que nomf soit vide, or vous le forcé à G8, donc pas souvent vide...

Par ailleurs en vous relisant, votre souhait est de se servir du fichier de base en modèle, alors vous pouvez écrire ceci:

Set wb = Workbooks.add (chemin2 & fichierDeBase)
wb.saveas (chemin & nomf & ".xlsb")

Bon code
 

pelerin65

XLDnaute Occasionnel
Bonsoir bouchard, et le forum

Merci pour ton code et ton aide

J'ai un problème avec ma listview, elle est intégrée sur une feuille de calcul afin pour d'avoir l'affichage en permanence de la journée de contrôle.

Le problème est que j ai mis dans les propriétés listestyle "fmliststyleoption" parfois je peux cocher les croix et utilisé la barre de défilement latérale.
Et pour certaines ouvertures du fichier, j'ai une croix et je peux rien cocher ni utilisé la barre de défilement

J'ai cherché durant des heures s'il y avait une initialisation de la listview, rien trouvé à part les USF

Je vous demande de l'aide afin de savoir s'il y a un code à rajouter pour un fonctionnement optimal

Je joins les deux fichiers le premier permet une recherche des fichiers existants ou non par la cellule "G8".

Si non, ouvre le fichier LOC NG 23 sur la feuille "Tableau de Bord" et on valide avec le bouton Notes Loc NG qui ouvre la feuille et initialise la recherche et affiche dans la listbox,

Cordialement

 

Pièces jointes

  • RECHERCHER FICHIER.xlsb
    707.6 KB · Affichages: 3

Staple1600

XLDnaute Barbatruc
Bonsoir le fil

@pelerin65
Juste en passant et pour info
Ci-dessous un petit extrait de la charte du forum
La charte¸ qui se désole d'être si peu lue à dit:
1.12 - Autres points d'attention :
...
Les problèmes liés à la fourniture de liens vers des fichiers téléchargeables en dehors du forum sont les suivants : les liens expirent souvent après une certaine durée, de nombreux utilisateurs ne peuvent pas télécharger de fichiers à partir de sites de partage de fichiers en raison de restrictions de sécurité réseau, de nombreux utilisateurs hésitent à télécharger des fichiers pour des raisons de sécurité personnelle et les fonctionnalités de recherche du forum ne fonctionnent pas.
2.10 - Évitez de poser votre question sur plusieurs forums sur Internet, cette pratique s'appelle « cross posting" et elle peut être mal perçue par les membres répondant aux questions. Si vous avez déjà posté votre question ailleurs, que nous n'avez pas de réponse satisfaisante et que vous voulez la reposter sur XLD, il est possible de supprimer votre discussion sur l'autre forum.
Cela fonctionne aussi dans l'autre sens si vous souhaitez poser votre question ailleurs.
 

pelerin65

XLDnaute Occasionnel
bonsoir le forum,

J'ai un problème d'enregistrement après sa sauvegarde
voila le code
Private Sub workbook_beforeclose(cancel As Boolean)

Dim Nom$: Nom = [D3]
Dim Nomfichier As String
Dim NomDossier As String
Dim Dte As Date
Dim dte1 As String

'Désactives les alertes
Application.DisplayAlerts = True
Application.ScreenUpdating = False
'*******************************************************************************************************************************
'Enregistrement du fichier complet
'*******************************************************************************************************************************
'Adresse de la sauvegarde
NomDossier = "C:\Loc Ng 23\04-Tournées realisées\" 'A ajuster selon ton cas
'Nom du dossier
Nomfichier = Nom & ".xlsb"
'Le fichier active est copié
ActiveWorkbook.SaveCopyAs Filename:=NomDossier & Nomfichier
' Message dinformation du lieu de l'enregistrement
MsgBox "votre ficher est enregistré intitulé:" & Nomfichier & vbNewLine & _
"dans le fichier : " & NonDossier, vbOKOnly, vbInformation, " CONFIRMATION"

'ActiveWorkbook.PrecisionAsDisplayed = True
'Application.DisplayFullScreen = False
'Application.DisplayFormulaBar = False

' With ActiveWindow
' .DisplayHorizontalScrollBar = True
' .DisplayGridlines = True
' .DisplayHeadings = True
' .DisplayVerticalScrollBar = True
' End With
'Application.Quit
End Sub

Lors du de la création de la sauvegarde, pas de soucis, ça sauvegarde correctement.

Je voudrais utiliser cette sauvegarde, lors de besoins futurs (" Tous les huit semaines") afin d'avoir les notes de la dernier tournée, c'est la que ca pose problème lors de sa fermeture.

J'ai essayé la méthode saveas même problème.

Pour résoudre ce problème, j'ai lu beaucoup de messages de forum,
je ne trouve pas

des idées !!!

j'ai un fichier nommé recherche de fichiers ( j'en ai à peu près une bonne centaine, de fichie,

soit nomme "N01, N02.... ou commencement par N1,N02.... ou PAR SE01,SE02.......

Lors d'une journée de travail, la recherche se fait par cette indexation "N) Tournéé"
Le fichier recherche et vérifie de la présence de la tournée en question

elle n'existe pas, le classeur crée un journée dans le fichier de base la la création du N° de fichier ouvre le fichier de Base LOC NG 2023 vierge

Le fichier existe, il l'ouvre

C'est la lors de l enregistrement avec d autres données ca bug
Je voudrais qu'il remplace le fichier plus ancien.


une idée de faire l enregistrement une procédure.

une idée merci d'avance de votre aide.
 

Staple1600

XLDnaute Barbatruc
Bonsoir

@pelerin65
Des idées , il y en a ici, non ? :rolleyes:
 

Discussions similaires

Statistiques des forums

Discussions
311 720
Messages
2 081 924
Membres
101 841
dernier inscrit
ferid87