Bonjour,
J'arrive actuellement au bout du périple consistant à consolider des fichiers, et il me reste un dernier problème.
J'utilise le code suivant :
Le principe est d'ouvrir les fichiers, de reporter les cellules mentionner puis de les refermer.
Le problème est que dans la plupart des fichiers ils s'ouvrent soit en lecture seule (donc un message "Vous lire ce fichier en lecture seule ?" apparait), soit un message apparait pour savoir si on souhaite l'enregistrer quand un fichier se ferme.
Résultat je passe mon temps à cliquer sur Oui et Non. Y aurait il un moyen d'intégrer une ligne ou deux dans le code, permettant ainsi aux fichiers de s'ouvrir et se fermer sans qu'on ait à cliquer à chaque fois ?
Cordialement,
Etn
J'arrive actuellement au bout du périple consistant à consolider des fichiers, et il me reste un dernier problème.
J'utilise le code suivant :
Code:
Private Function ChoisirDossier() As String
Dim objShell
Dim objFolder
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder _
(&H0&, "Sélectionnez un Dossier", &H1&)
On Error GoTo Erreur
ChoisirDossier = objFolder.ParentFolder _
.ParseName(objFolder.Title).Path & ""
Exit Function
Erreur:
ChoisirDossier = ""
End Function
Sub NOM()
Dim FSO 'As Scripting.FileSystemObject
Dim SourceFolder 'As Scripting.Folder
Dim FileItem 'As Scripting.File
Dim chemin$
Dim T()
Dim cpt&
Dim g&
Dim i&
Dim j&
Dim Lig&
Dim var
Dim WB As Workbook
Dim S As Worksheet
Dim DEST As Worksheet
Dim Info(1 To 1, 1 To 26)
'------------
chemin$ = "C:\Downloads"
If chemin$ = "" Then Exit Sub
Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(chemin$)
If SourceFolder.Files.Count = 0 Then Exit Sub
For Each FileItem In SourceFolder.Files
If LCase(Right(FileItem.Name, 4)) = ".xls" Or LCase(Right(FileItem.Name, 5)) = ".xlsx" Or LCase(Right(FileItem.Name, 5)) = ".xlsm" Then
cpt& = cpt& + 1
ReDim Preserve T(1 To cpt&)
T(cpt&) = chemin$ & "\" & FileItem.Name
End If
Next FileItem
Set FileItem = Nothing
Set SourceFolder = Nothing
Set FSO = Nothing
'------------
Application.ScreenUpdating = False
Set DEST = Sheets.Add
Lig& = 1
For g& = 1 To UBound(T)
Set WB = GetObject(T(g&))
Set S = WB.Sheets("NOM")
Info(1, 1) = S.Range("c1")
Info(1, 2) = S.Range("d35")
Info(1, 3) = S.Range("d36")
Info(1, 4) = S.Range("e35")
Info(1, 5) = S.Range("e36")
WB.Close
Set WB = Nothing
Lig& = Lig& + 1
DEST.Range(DEST.Cells(Lig&, 1), _
DEST.Cells(Lig&, UBound(Info, 2))) = Info
Erase Info
Next g&
var = Array("NOM")
With DEST
.Range(.Cells(1, 1), .Cells(1, UBound(var) + 1)) = var
.Range("a1:e1").Interior.ColorIndex = 6
End With
Application.ScreenUpdating = False
Exit Sub
Erreur:
Application.ScreenUpdating = False
MsgBox "Erreur " & Err.Number & vbCrLf & Err.Description
End SubLe principe est d'ouvrir les fichiers, de reporter les cellules mentionner puis de les refermer.
Le problème est que dans la plupart des fichiers ils s'ouvrent soit en lecture seule (donc un message "Vous lire ce fichier en lecture seule ?" apparait), soit un message apparait pour savoir si on souhaite l'enregistrer quand un fichier se ferme.
Résultat je passe mon temps à cliquer sur Oui et Non. Y aurait il un moyen d'intégrer une ligne ou deux dans le code, permettant ainsi aux fichiers de s'ouvrir et se fermer sans qu'on ait à cliquer à chaque fois ?
Cordialement,
Etn
Dernière modification par un modérateur:
