Fomctiom Dir qui renvoie un fichier qui n'arrive pas à s'ouvrir

Zou -
Thorak83 Messages postés 1051 Date d'inscription Statut Membre Dernière intervention - 20 juin 2013 à 14:29

Bonjour,
Je cherche à faire une synthèse de fiches avec plusieurs informations dans un tableau,
j'écrit le code suivant

Sub Synthese()
Application.ScreenUpdating = False
Cells.Delete
Range("A1") = "Name"
Range("B1") = "Nr."
Range("C1") = "m2"
Range("D1") = "Betroffener Dienst"
Range("E1") = "Block Nr."
Range("F1") = "Etage"
Range("G1") = "ZimmerZahl"
Range("A1:G1").Font.Bold = True

'Recherche des différents fichiers'
' Parcours de tous les fichiers
' -----------------------------
ChDir ThisWorkbook.Path
VPB = Dir(ThisWorkbook.Path & "\*.xlsx")
While Len(VPB) > 0
Workbooks.Open VPB
Dim Name As String
Dim Nr As String
Dim m2 As Integer
Dim BD As String
Dim Block As String
Dim Etage As String
Dim ZZahl As Integer
BD = Worksheets("VBP").Range("L15")
Nr = Worksheets("VBP").Range("P11")
m2 = Worksheets("VBP").Range("P29")
Block = Worksheets("VBP").Range("M13")
Etage = Worksheets("VBP").Range("P13")
ZZahl = Worksheets("VBP").Range("V18")
Workbooks("PVBSammelung.xlsm").Activate
'debut de l'écriture des noms du fichier'
Ligne = ActiveSheet.Range("A65536").End(xlUp).Row + 1
Range("A" & Ligne).Value = VPB
Range("B" & Ligne).Value = Nr
Range("C" & Ligne).Value = m2
Range("D" & Ligne).Value = BD
Range("E" & Ligne).Value = Block
Range("F" & Ligne).Value = Etage
Range("G" & Ligne).Value = ZZahl
Workbooks(VPB).Close
VPB = Dir
Wend

' Fin des travaux
' ---------------
Columns("A:A").Replace ".xlsx", ""
Cells.EntireColumn.AutoFit
Range("A1").Select
LigneTotal = Range("A65536").End(xlUp).Offset(1, 0).Row
Range("A" & LigneTotal) = "TOTAUX :"
Range("C" & LigneTotal).FormulaLocal = "=Somme(C2:C" & LigneTotal - 1 & ")"
Range("C" & LigneTotal).FormulaLocal = "=Somme(C2:C" & LigneTotal - 1 & ")"
Range("G" & LigneTotal).FormulaLocal = "=Somme(G2:G" & LigneTotal - 1 & ")"
Range("A" & LigneTotal & ":G" & LigneTotal).Font.Bold = True
'Mise en formes totaux'
Range("C" & LigneTotal).Borders.LineStyle = wdLineStyleSingle
Range("C" & LigneTotal).Borders.LineStyle = wdLineWidth150pt
Range("G" & LigneTotal).Borders.LineStyle = wdLineStyleSingle
Range("G" & LigneTotal).Borders.LineStyle = wdLineWidth150pt

Application.ScreenUpdating = True

End Sub
A l'endroit en gras, VBA m'annonce aque le fichier est introuvable. Ce qui est étrange c'est que tout marchait bien lorsque je n'avais pas d'instruction chdir mais seulement : dir8*.xlsx). Je precise que tous mes fichiers sont dans le meme dossier y compris celui de synthese sauf qu'il est en xlsm.
Après test, j'constaté aue ça a arreté de marcher parceque VBA cherchait dans le dossier D et nom plus le serveur sur le quel sont présents mes documents. D'ou l'ajout de chdir...
Avez vous une idée pour m'aider svp???

Afficher la suite

A voir également:

Fomctiom Dir qui renvoie un fichier qui n'arrive pas à s'ouvrir
Comment ouvrir un fichier epub ? - Guide
Comment ouvrir un fichier bin ? - Guide
Ouvrir un fichier .dat - Guide
Comment ouvrir un fichier docx ? - Guide
Comment ouvrir un fichier 7z - Guide

1 réponse

Réponse 1 / 1

Thorak83 Messages postés 1051 Date d'inscription Statut Membre Dernière intervention 156

Hello
Voici une structure de boucle, qui fonctionne, pour la lecture de fichiers dans un dossier. Reste plus qu'a adapter

  Dim Chemin As String
  Dim Fichiers As String
  Dim VPB As String
  Chemin = ThisWorkbook.path
  Fichiers = Dir(Chemin & "\*.xlsx", vbDirectory)
  Do While (Fichiers <> "")
    VPB = Chemin & "\" & Fichiers
    Workbooks.Open VPB
    Fichiers = Dir
  Loop

Votre réponse