Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Branchement selon conditions

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

aubelix

XLDnaute Impliqué
Bonsoir à tous les Amis du Forum. 🙂

Une nouvelle fois, je sollicite votre aide.

Pourriez-vous me corriger le code ci-dessous.
Je cherche un répertoire, si je le trouve, j'ouvre le fichier INDEX_NUM.xls.
Je recopie la valeur de la cellule A2 dans la feuille BASE dans le cellule A2
du classeur PROJET_V1.xls.

Si je ne letrouve pas, j'écris "1" dans la cellule A2 de la feuille BASE dans
du classeur PROJET_V1.xls.

Pourriez-vous m'aider.
Par avance Merci.
Cordialement.


Code:
[COLOR=green]  'chercher le fichier dans le dossier et ses sous-dossiers[/COLOR]
    pathClasseur = FindFile(pathDossier, nomClasseur)
    [COLOR=green]'si on n'a pas trouvé le fichier on se branche sur Ligne1[/COLOR]
    If pathClasseur = "" [COLOR=blue]Then[/COLOR] [COLOR=blue]GoTo[/COLOR] Ligne1 Else [COLOR=blue]GoTo[/COLOR] Ligne2
 
Ligne1:
Windows("PROJET_V1.xls").Activate
Sheets("BASE").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
[COLOR=blue]GoTo[/COLOR] Ligne3
 
Ligne2:
[COLOR=green]'ouvrir le classeur en lecture seule[/COLOR]
Set classeur = Application.Workbooks.Open(pathClasseur, , True)
 
Windows("INDEX_NUM.xls").Activate
Sheets("INDEX_NUMERO").Select
 
Range("A2").Select
Selection.Copy
 
Windows("PROJET_V1.xls").Activate
Sheets("BASE").Select
Range("A2").Select
 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                              :=False, Transpose:=[COLOR=blue]False[/COLOR]
[COLOR=darkgreen]'fermer le classeur[/COLOR]
Windows("INDEX_NUM.xls").Activate
Windows("INDEX_NUM.xls").Close False
 
[COLOR=blue]GoTo[/COLOR] Ligne3
 
Ligne3:
Unload USF_saisies
Usf_ImportSN.Show
[COLOR=blue]Exit Sub[/COLOR]
 
[COLOR=blue]End Sub[/COLOR]
 
Re : Branchement selon conditions

Bonsoir [EDITION, sieur kjin, mes hommages du soir 😉]


Personnellement j'écrirai à la place de ceci
Code:
Windows("PROJET_V1.xls").Activate
Sheets("BASE").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A2").Select
cela
Code:
Windows("PROJET_V1.xls").Sheets("BASE").Range("A2")= "1"

et au lieu de
Code:
Windows("INDEX_NUM.xls").Activate
Sheets("INDEX_NUMERO").Select
 
Range("A2").Select
Selection.Copy
 
Windows("PROJET_V1.xls").Activate
Sheets("BASE").Select
Range("A2").Select
 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                                                              :=False, 
Transpose:=False
j'écrirai
Code:
Windows("PROJET_V1.xls").Sheets("BASE").Range("A2").Value=Windows("INDEX_NUM.xls").Sheets("INDEX_NUMERO").Range("A2").Value
 
Dernière édition:
Re : Branchement selon conditions

Bonsoir,
Pourriez-vous m'aider.
Non 😀
Le pb c'est que tu n'indiques pas ce que renvoie FindFile
D'autre part il faut peut-être verifier que la feuille base existe ?
Avec ce que j'ai compris...
Code:
pathclasseur = FindFile(pathDossier, nomClasseur)
If pathclasseur = "" Then
    Set wb2 = Workbooks.Open(pathclasseur)
    lavaleur = wb2.Sheets("BASE").Range("A2")
    wb2close False
Else
    Range("A2") = "I"
End If
Unload USF_saisies
Usf_ImportSN.Show
A+
kjin
 
Re : Branchement selon conditions

Bonjour et remerciements matinaux à toi Staple1600, Kjin et Amis du Forum. 🙂

Merci pour vos réponses respectives.

Kjin, c'est l'esprit de ce que je voulais mais j'ai été avare d'infos:
La philosophie de ta macro correspond à ce que je veux obtenir.
Je précise ma pensée:
Je suis sur le fichier "PROJET_V1.xls" et sur la feuille "BASE"
Je cherche le sous-répertoire de la valeur de la "cellule G2".
Tout fonctionne bien, mais je vous demande l'aide suite de la macro à savoir:

-Si le sous-répertoire n'est pas trouvé, écrire "1" dans la "cellule A2" de la feuille "BASE" et se brancher sur la suite (Ligne3 dans mon cas)

-Si le sous-répertoire est trouvé ouvrir le fichier "INDEX_NUM.xls"
Lire la valeur de la cellue A2 de la feuille "INDEX_NUMERO" la copier
dans la "cellule A2" du fichier "PROJET_V1.xls" et sur la feuille "BASE" en ajoutant 1 (exemple 5 > 5+1 donc ajouter 6).

Fermer le le fichier "INDEX_NUM.xls" sans le sauvegarder.

et et se brancher sur la suite (Ligne3 dans mon cas)

Par avance, Merci de votre aide.
Cordialement.
 
Re : Branchement selon conditions

Bonjour,
On ne sait toujours pas ce que renvoie FindFile !!!
Code:
Dim ws As Worksheet, wb As Workbook
Set ws = ThisWorkbook.Sheets("BASE")
pathclasseur = FindFile(pathDossier, nomClasseur)
If pathclasseur <> "" Then
    Set wb = Workbooks.Open(pathclasseur)
    ws.Range("A2") = wb.Sheets("INDEX_NUMERO").Range("A2") + 1
    wb.Close False
Else
    ws.Range("A2") = 1
End If
'Unload USF_saisies
'Usf_ImportSN.Show
A+
kjin
 
Re : Branchement selon conditions

Bonjour Kjin. 🙂

Merci pour ta réponse.
Sans l'avoir testée, je te renvoie la fonction que j'ai trouvée sur le Forum
si cela peut t'être utile pour ta réponse.

Code:
Private Function FindFile(pathDossier As String, nomFichier As String) As String
    Dim myFso As Object, dossier As Object, ssDossier As Object, fichier As Object, pathFichier As String
    'créer un "FileSystemObject"
    Set myFso = CreateObject("Scripting.FileSystemObject")
    'récupérer le dossier passé en paramètre
    Set dossier = myFso.GetFolder(pathDossier)
    'boucler sur chaque fichier du dossier
    For Each fichier In dossier.Files
        'si le fichier correspond à celui cherché, renvoyer le path du fichier et quitter la fonction
        If fichier.Name = nomFichier Then FindFile = fichier.Path: Exit Function
    Next fichier
    'boucler sur chaque sous-dossier du dossier
    For Each ssDossier In dossier.SubFolders
        'rappeler la fonction sur le sous-dossier
        pathFichier = FindFile(ssDossier.Path, nomFichier)
        'si le fichié a été trouvé, renvoyer le path du fichier et quitter la fonction
        If pathFichier <> "" Then FindFile = pathFichier: Exit Function
    Next ssDossier
End Function

Merci pour ton aide.
Cordialement.
 
Dernière édition:
Re : Branchement selon conditions

Bonsoir à tous


Monsieur Kjin
Selon ce principe ,elle fonctionne mieux 😉

Code:
Sub Je_Suis_Une_Macro()
Dim ws As Worksheet, wb As Workbook
Set ws = ThisWorkbook.Sheets("BASE")
pathclasseur = FindFile(pathDossier, nomClasseur)
If pathclasseur <> "" Then
    Set wb = Workbooks.Open(pathclasseur)
    ws.Range("A2") = wb.Sheets("INDEX_NUMERO").Range("A2") + 1
    wb.Close False
Else
    ws.Range("A2") = 1
End If
'Unload USF_saisies
'Usf_ImportSN.Show
End sub

NB :Car un accident de copier/collé est si vite arrivé
Soyons prudent ajoutons le va de soi dans le code 😉
 
Re : Branchement selon conditions

Bonjour Staple1600. 🙂

Merci pour ta réponse.

Cela fonctionne quand il trouve le dossier.
Mais s'il ne le trouve pas, il va chercher le dernier dossier, comme
s'il l'avait trouvé.

Une précision: j'ai des variables dans code en amont le problème
ne viendrait-il pas de là ?
Ci-dessous le code :

Code:
Private Sub CommandButton1_Click()
    Dim pathDossier As String, nomClasseur As String, pathClasseur As String
    Dim classeur As Workbook
    NumREF = Range("G2").Value
    nomClasseur = "INDEX_NUM.xls"
    pathDossier = "C:\REP1\REP2\REP3\REP4\"
 
    Dim ws As Worksheet, wb As Workbook
    Set ws = ThisWorkbook.Sheets("BASE")
    pathClasseur = FindFile(pathDossier, nomClasseur)
    If pathClasseur <> "" Then
        Set wb = Workbooks.Open(pathClasseur)
        ws.Range("A2") = wb.Sheets("INDEX_NUMERO").Range("A2") + 1
        wb.Close False
    Else
        ws.Range("A2") = 1
    End If
    'Unload USF_saisies
    'Usf_ImportSN.Show
End Sub
 
 
Private Function FindFile(pathDossier As String, nomFichier As String) As String
    Dim myFso As Object, dossier As Object, ssDossier As Object, fichier As Object, pathFichier As String
    'créer un "FileSystemObject"
    Set myFso = CreateObject("Scripting.FileSystemObject")
    'récupérer le dossier passé en paramètre
    Set dossier = myFso.GetFolder(pathDossier)
    'boucler sur chaque fichier du dossier
    For Each fichier In dossier.Files
        'si le fichier correspond à celui cherché, renvoyer le path du fichier et quitter la fonction
        If fichier.Name = nomFichier Then FindFile = fichier.Path: Exit Function
    Next fichier
    'boucler sur chaque sous-dossier du dossier
    For Each ssDossier In dossier.SubFolders
        'rappeler la fonction sur le sous-dossier
        pathFichier = FindFile(ssDossier.Path, nomFichier)
        'si le fichié a été trouvé, renvoyer le path du fichier et quitter la fonction
        If pathFichier <> "" Then FindFile = pathFichier: Exit Function
    Next ssDossier
End Function

Il garde en mémoire le dernier dossier sauvegardé.
Pour info, lorsque je ferme le classeur, j'efface toutes les données
et j'écris "1" dans la cellule A2 de la la "feuille BASE".


Merci pour votre aide.
Cordialement.
 
Dernière édition:
Re : Branchement selon conditions

Bonsoir à tous les Amis du Forum. 😉

Je me permets de vous relancer, car on est presque arrivé mais :
Comme je vous l'ai écris, la macro garde en mémoire le dernier fichier sauvegardé.
Il va rechercher systématiquement la dernière valeur du fichier INDEX_NUMERO. 😕
Pouvez-vous m'aider à finaliser ce projet.

Par avance , merci pour votre aide.
Cordialement.
 
Re : Branchement selon conditions

Bonjour Les Amis du Forum et Staple1600. 🙂

Tout d'abord, Merci pour ta réponse.
J'ai essayé d'adapter le fichier à ce que j'aimerais obtenir.
Une version allégée.

Le but, via un USF des données sont saisies et reportées dans les différents champs
dans la feuille "BASE". Tout cela fonctionne correctement. Le problème se situe au nineau
du dernier numéro utilisé, qui doit être incrémenté. En quittant, on crée un dossier de la
valeur de la cellule "G2" avec un fichier INDEX_NUM.xls avec la dernière valeur en A2 utiilsée.
Puis lorsqu'on resaisi des données, la mcro doit rechercher le dossier s'il éxiste dans :
pathDossier = "C:\REP1\REP2\REP3\REP4\" et ouvrir INDEX_NUM.xls et copier la valeur
la cellule A2 + 1 dans la feuille BASE en cellule A2. S'il n'éxiste pas, écrire 1 la dans la feuille BASE en cellule A2



Actuellement, c'est le dernier dossier crée qui es gardé en mémoire.

Par avance, Merci pour votre aide.
Cordialement.
 
Dernière édition:
Re : Branchement selon conditions

Bonjour,
Il me semble que tu oublies un détail...(que j'ai ajouté)
....n'y aurait-il pas comme un chmurx !
A+
kjin
 
Re : Branchement selon conditions

Re Bonjour Staple6000.

Comme je te l'ai dis, j'ai allégé le code.
Je n'ai pas pu faire autrement.
Le lien pour télécharger le fichier dans cijoint.fr.

Une fois le fichier télécharger.
Ecrire dans la cellule G2 de la feuille "BASE"
ajouter quelques données dans la colonne B2 à Bn pour incrémenter le N°.
Cliquer sur QUITTER. Un répertoire est crée sous REp1\REP2......\valeur de la cellule "G2" de la feuille BASE
Avec un fichier INDEX_NUM.xls qui reporte la valeur Maxi du numéro enregistré.

Ouvrir de nouveau INDUEX_NUMERO.xls
Ecrire en G2 le même numéro ou un numéro différent cellule G2 de la feuille "BASE"
et cliquer sur LANCER.

Si le numéro de dossier éxiste, il ouvrira le fichier INDEX_NUM.xls et recopiera la valeur de A2 +1 dans la feuille
BASE en A2.

si il n'éxiste pas, il écrira 1 en A2 de la feuille BASE.

C'est en quittant, que sera crée ce dossier avec le numéro MAXI

J'espère avoir été clair.

Cordialement.
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…