Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Piboulet

XLDnaute Nouveau
Bonjour à tous.
A partir d’éléments trouvés dans ce forum je tente d’utiliser une macro qui ouvre successivement tous les fichiers du répertoire de la macro et cela fonctionne correctement. Toutefois, dés que je change de répertoire, le système demande des fichiers d’un autre répertoire (le plus souvent sur C ) et la macro plante. Je ne comprends pas la logique
J’ai trouvé quelques astuces : installer sur nouveau répertoire, ouvrir, enregistrer, fermer, ré enregistrer en changeant le nom, et ça marche au bout d’un moment. Je me vois mal expliquer de faire toutes ces ruses à mes collaborateurs.
Peux t’on modifier la macro pour que le changement de répertoire soit pris en compte immédiatement??
Sub impr_finale()
Dim FichAOuvr, NomFich, NumeFich, Chemin As String
Chemin = ThisWorkbook.Path & "\"
ChDir Chemin
NomFich = Dir("*.xls")
NumeFich = 1
While NomFich <> ""
If NomFich = ThisWorkbook.Name Then GoTo fin
FichAOuvr = Chemin & NomFich
Workbooks.Open Filename:=FichAOuvr, UpdateLinks:=0
MsgBox "Impression (pour de faux)"
ActiveWorkbook.Close
fin:
NomFich = Dir
NumeFich = NumeFich + 1
Wend
MsgBox "C'est fini! (Cycle terminé)"
End Sub
Merci pour votre aide
 

skoobi

XLDnaute Barbatruc
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Bonjour,

A aucun moment tu as un changement de répertoire dans la macro donc si tu changes "manuellement" de répertoire, ça ne servira à rien, la macro ira systématiquement dans le répertoire du fichier ouvert.

et la macro plante

Quel est le message?
Sur quelle ligne?
 

Piboulet

XLDnaute Nouveau
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Bonsoir skoobi, et tout le monde
Une histoire de Ouf! Je n'arrive pas à reproduire l'incident (au domicile) alors que hier soir (domicile) et aujourd'hui (boulot) je l'avais eu plusieurs fois!
Comme tu le dis, la macro détecte bien quelle est son répertoire, et aucune raison valable pour chercher en dehors. Mais parfois, lors d'un déplacement de fichier d'un répertoire à l'autre; la macro tente d'accéder à d'autres noms de fichiers sur un autre répertoire (souvent dans ""mes documents""), et bien sûr n'arrive pas à les ouvrir puiqu'ils ne sont pas sur le répertoire en cours . Il s'affiche un message "" le fichier bolobolo.xls est introuvable"". C'est incompréhensible. Dés que cela se reproduit, je capture l'écran, et je demande à l'aide.
Merci pour votre intêret.:eek:
 

skoobi

XLDnaute Barbatruc
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Re,

Je soupsonne un changement de lecteur, je m'explique:
Si ton fichier se trouve sur C:\ et que tu le déplace vers D:\ la commande "ChDir" change le répertoire mais pas le lecteur. Tu dois le préciser avant avec "ChDrive":

ChDrive "D:\"
ChDir Chemin

A tester.
 

Piboulet

XLDnaute Nouveau
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Bonsoir skoodi, le forum
Bingo! La macro semble avoir du mal a se caler sur un lecteur, même en lisant le bon chemin. Bizarre. J’ai modifié le code en prenant le lecteur dans les 3 premiers caractères du chemin que je copie et converti dans une cellule. je ne suis pas très fier de cette écriture VBA, mais cela à l’air de marcher. (en fait je le mettrais dans Workbook_Open) Je reste toutefois prudent… Connaissez vous - ou quelqu'un sur le forum - le moyen plus pro de mémoriser le lecteur actif ??? je suis preneur...Voici le code modifié :

Sub impr_finale()
Dim FichAOuvr, NomFich, NumeFich, Chemin, RepCourant, Drv As String
Chemin = ThisWorkbook.Path & "\"
Range("A1") = ThisWorkbook.Path
Range("A1").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(3, 9)), TrailingMinusNumbers:=True
ChDrive Range("A1")
NomFich = Dir("*.xls")
NumeFich = 1
While NomFich <> ""
If NomFich = ThisWorkbook.Name Then GoTo fin
FichAOuvr = Chemin & NomFich
Workbooks.Open Filename:=FichAOuvr, UpdateLinks:=0
MsgBox "Impression (pour de faux)"
ActiveWorkbook.Close
fin:
NomFich = Dir
NumeFich = NumeFich + 1
Wend
MsgBox "C'est fini! (Cycle terminé)"
End Sub
 

Piboulet

XLDnaute Nouveau
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Bonjour skoodi, le Forum
le système suivant fonctionne bien dans toutes les situations de changement de lecteur.
Range("A1") = ThisWorkbook.Path
Range("A1").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), Array(3, 9)), TrailingMinusNumbers:=True
ChDrive Range("A1")
Avez vous une solution plus courte pour indiquer le lesteur en cours à la Macro??
Merci encore pour votre concours.
 

MJ13

XLDnaute Barbatruc
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Bonjour Piboulet, Skoobi et le forum

essaies ce code
Code:
Sub impr_finale()
Dim FichAOuvr, NomFich, NumeFich, Chemin As String
'Chemin = ThisWorkbook.Path & "\"
Chemin = CurDir
ChDir Chemin
NomFich = Dir("*.xls")
NumeFich = 1
While NomFich <> ""
If NomFich = Chemin & "\" & ThisWorkbook.Name Then GoTo fin
FichAOuvr = Chemin & "\" & NomFich
Workbooks.Open Filename:=FichAOuvr, UpdateLinks:=0
MsgBox "Impression (pour de faux)"
ActiveWorkbook.Close
fin:
NomFich = Dir
NumeFich = NumeFich + 1
Wend
MsgBox "C'est fini! (Cycle terminé)"
End Sub
 

skoobi

XLDnaute Barbatruc
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Bonjour MJ13, Piboulet,

Avez vous une solution plus courte pour indiquer le lesteur en cours à la Macro??

Chemin = ThisWorkbook.Path & "\"
Lecteur = Left(Chemin, 3)
ChDrive Lecteur
ChDir Chemin

Attention: ceci marche si le lecteur est une lettre, si tu as un nom de serveur (\\Serveur\) , il faudra procéder autrement.
 

Piboulet

XLDnaute Nouveau
Re : Pb pour Ouverture_travail_fermeture tous les classeurs d’un répertoire

Bonjour M13, skoobi
et Merci!!!
les 2 solutions proposées fonctionnent à merveille!
une préférence pour la proposition de skoobi qui fonctionne directement sans enregistrement ni rien. Le code de M13 fonctionne également, mais aprés un "enregistrer sous". Du moins dans ma configuration réseau.
Toujours aussi efficace, bonne journée.
 

Discussions similaires

Statistiques des forums

Discussions
312 492
Messages
2 088 936
Membres
103 987
dernier inscrit
Doctami