Ouvrir un fichier dans un repertoir supérieur

[Delirium]

Bonjours à tous les XLiens.

Je cherche comment ouvrir un classeur qui se situe dans un repertoire superieur du classeur qui est ouvert.

En plus clair, j'ai un dossier, dans lequel il y a un classeur 'Menu.xls' et un sous dossier 'Données'.
Dans ce dossier 'Données' il y a un autre Dossier '01' qui lui même comporte un classeur 'classeur1.xls'.
Je voudrais ouvrir le classeur 'Menu.xls' a partir du classeur '01' grace à une macro en utilisant un code avec 'ThisWorkbook.Path &' et non pas un chemin d'accés complet de type 'c:\\Mon dossier\\Menu.xls'.

Je connais le code pour ouvrir un classeur dans un sous repertoire, mais pas dans un repertoir superieur.

J'ai cherché dans le forum, mais je n'est pas trouvé la solution.

Si quelqu'un connait la solution, Merci.

@+

 

[Staple1600]

Bonjour

Peut être avec
ChDir

' 'MONREP' devient le répertoire ou le dossier courant.
ChDir 'MONREP'

' En supposant que 'C:' soit le lecteur courant,' l'instruction suivante
' change le dossier par défaut pour le placer sur le lecteur 'D:'. 'C:'
' reste le lecteur courant.
ChDir 'D:\\WINDOWS\\SYSTEM'


(voir aide Excel)

 

[MichelXld]

bonjour Delirium , bonjour Staple1600

tu peux tester cette macro pour recuperer le nom du repertoire parent du classeur contenant la macro


ChDir (ThisWorkbook.Path)
ChDir '..'
MsgBox CurDir


bonne soiree
MichelXld

Message édité par: MichelXld, à: 16/08/2005 21:23

 

[Delirium]

Bonsoir MichelXld et Staple1600.

J'ai du mal m'expliquer .

Je ne cherche pas à connaitre le repertoire superieur de mon classeur mais ouvrir un classeur qui se touve dans le repertoir superieur.

Je cherche une macro du style :

Workbooks.Open Filename:=ThisWorkbook.Path & '\\ (repertoire superieur )\\Menu.xls'

Le code que je vien de donner sert à ouvrir un classeur dans un repertoire inferieur, alors que je cherche à faire l'inverse.

je ne veut pas que le code comporte le chemin d'accés complet à mon classeur 'Menu.xls' de type Workbooks.Open Filename:= 'c:Mon
dossierMenu.xls' car mon application doit pouvoir être déplacée.

Je pense qu'Il faut utiliser un code avec 'ThisWorkbook.Path &' mais je ne sais pas comment.

En espérant avoir été plus clair, merci de votre aide.

@+

 

[MichelXld]

rebonsoir Delirium

je suis sans doute tétu comme un breton , ou alors je rien compris...;o)

cet exemple remonte le repertoire parent par rapport au classeur contenant la macro

ChDir (ThisWorkbook.Path)
ChDir '..'
Workbooks.Open Filename:=CurDir & '\\Menu.xls'

cet exemple remonte 2 repertoires parents par rapport au classeur contenant la macro

Dim Chemin As String
ChDir (ThisWorkbook.Path)
ChDir '..'
Chemin = Left(CurDir, InStrRev(CurDir, '\\') - 1)
Workbooks.Open Filename:=Chemin & '\\Menu.xls'

bonne soiree
MichelXld

 

[Delirium]

:angry: C'est quoi cette opinion des bretons ?

LOL suis juste 'sous' Breton.

Bon pour ce qui est de ton code, merci sa marche nickel !

Mais je n'es pas compris se que je fais (et j'aime bien comprendre).

Donc ton code déclare le chemin depuis mon premier classeur jusqu'à 'Menu.xls', mais cela be fonctionne que si il est dans le 2ème repertoir parent. Or si l'on à plus de repertoire parent que doit on changer dans ton code ?

Merci et @+.

 

[myDearFriend!]

Bonsoir Delirium, MichelXLD,

Sauf erreur de ma part, il ne faut rien modifier dans le code Delirium, il convient simplement d'insérer une nouvelle ligne :

ChDir '..'

supplémentaire pour chaque niveau supérieur.

Cordialement,

 

[Delirium]

Merci myDearFriend pour la précision.

Mais j'ai encore un petit problème, les codes que MichelXld m'a donné ne fonctionne plus XL m'affiche :


'Erreur d'execution '1004':
'D:\\\\Menu2.xls' introuvable. Vérifiez l'ortographe du nom du classeur et la validité de l'emplacement.

Si vous essayez d'ouvrir le fichier à partir de la liste des fichier récents, assurez vous que le fichier n'a pas été renomé, déplacé ou supprimé.


Or cela à bien fonctionner la 1° fois mais maintenant imposible d'executer l'une des 2 macro de MichelXld.

Et je n'ai ni renomer ni supprimmer de fichier.

Par contre mes fichier ne se sont jamais trouvés sur D: comme décrit dans le message d'excel mais sur 'E:'.

Il doit y avoir un problème dans le code.

Je joint mes dossiers en fichier joint. Le classeur qui comporte les macro de MichelXld et dans le dernier répertoire 'classeur1.xls'.

Merci de me donner un petit coup de main .

@+

 

[myDearFriend!]

Re Delirium,

Bon, tout d'abord je t'avoue ne pas être très à l'aise avec ce type de code... Pour régler ton problème, je suppose qu'il conviendrait d'utiliser ChDrive(). Mais cette méthode n'est pas vraiment recommandée car tu modifies ainsi le chemin et le lecteur courant 'au nez et à la barbe' de l'utilisateur ce qui n'est pas vraiment XLcompliant nous dirait un certain belge monégasque anglophone...

Je te propose donc d'essayer (en attendant mieux et ça ne tardera pas lol !) la solution tordue, de fin de soirée, suivante :

Sub Test()
Dim Chemin As String
      'Avec la Function suivante, on obtient le Chemin du Menu en remontant dans la hierarchie
      'des dossiers selon le paramètre suivant :
     
      ' O = restera au niveau du classeur courant
      '-1 = remontera d'un niveau dans la hierarchie les dossiers (c'est l'exemple choisi)
      '-2 = remontera de deux niveaux dans la hierarchie des dossiers
      ' ...etc...
     
      Chemin = ChemMenu(ThisWorkbook.FullName, -1)
      MsgBox 'Chemin du Menu = ' & Chemin & 'Menu.xls'
End Sub

Private Function ChemMenu(ByVal Chaine As String, NivInferieur As Integer) As String
      Do
            Chaine = Left(Chaine, InStrRev(Chaine, '\') - 1)
            NivInferieur = NivInferieur + 1
      Loop Until NivInferieur > 0
      ChemMenu = Chaine & '\'
End Function

Cordialement,

EDITION : Attention toutefois, cette fonction ne comporte pas de gestion d'erreur... Si tu souhaites remonter dans la hierarchie des dossiers au-delà de ce qui est physiquement présent sur ton disque... plantage assuré !

Message édité par: myDearFriend!, à: 17/08/2005 02:49

 

[MichelXld]

bonjour Delirium , Staple1600 et mon cher Didier

Didier , merci d'avoir pris le relais ...;o)


bonne journée
MichelXld

 

[Delirium]

Bonsoir MichelXld et myDearFriend!.

Le code de myDearFriend! semble bien fonctionner (avoir une fois adapté à mon appli).

Je l'ai juste modifié comme cela :

Sub Test()
Dim Chemin As String    
      Chemin = ChemMenu(ThisWorkbook.FullName, -1)
      Workbooks.Open Filename:=Chemin & 'Menu3.xls'
      End Sub
Private Function ChemMenu(ByVal Chaine As String, NivInferieur As Integer) As String
      Do
            Chaine = Left(Chaine, InStrRev(Chaine, '\\') - 1)
            NivInferieur = NivInferieur + 1
      Loop Until NivInferieur > 0
      ChemMenu = Chaine & '\\'
End Function

Mais j'ai testé dans le cas ou le fichier n'exsiste pas, un mssage d'erreur apparait (normal !), mais je cherche à incerer un msg dans le code.

FichierManquant_Err:
msg = 'Un fichier nécessaire à l'execution du programme est manquant. Veuillez réinstaller le programme.'
        Style = vbCritical + vbDefaultButton2
        Title = 'Fichier manquant !'
       Réponse = MsgBox(msg, Style, Title)
        Exit Sub

Mais je ne vois pas ou le mettre !

Encore une fois, Merci à vous deux.

 

[myDearFriend!]

Bonsoir Delirium, MichelXLD, le Forum.

Tu peux éventuellemnt essayer comme ça :

Option Explicit

Sub Test()
Dim Chemin As String, msg As String, Title As String
Dim Style As Integer

      Chemin = ChemMenu(ThisWorkbook.FullName, -1)
      On Error GoTo FichierManquant_Err
      Workbooks.Open Filename:=Chemin & 'Menu3.xls'
      On Error GoTo 0
Exit Sub
     
FichierManquant_Err:
      msg = 'Un fichier nécessaire à l'execution du programme est manquant. Veuillez réinstaller le _
              programme.'
      Style = vbCritical + vbOKOnly
      Title = 'Fichier manquant !'
      MsgBox msg, Style, Title
End Sub

Private Function ChemMenu(ByVal Chaine As String, NivInferieur As Integer) As String
      On Error Resume Next
      Do
            Chaine = Left(Chaine, InStrRev(Chaine, '\') - 1)
            NivInferieur = NivInferieur + 1
      Loop Until NivInferieur > 0
      ChemMenu = Chaine & '\'
      On Error GoTo 0
End Function

Cordialement,


PS: salut Michel, en ce moment je suis en train de passer ma licence de pilote... c'est pas facile... je m'accroche... heu... mais non je rigole, mais grâce à toi je peux déjà Ce lien n'existe plus c'est déjà pas mal ! Encore une fois merci pour tout ce que tu nous apportes !

 

[Delirium]

Merci myDearFriend! et MichelXld.

Cela marche nickel maintenant.

A bientôt sur un autre fil