Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Fichier déjà ouvert

7 réponses
Avatar
GGAL
Bonjour,

J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.

Merci d'avance,

Ggal

Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "\Truc\"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub

7 réponses

Avatar
Jacques ALARDET
Bonjour GGAL

Plusieurs solutions :

La plus simple peut être est de faire, avant chaque ouverture :
On Error goto E1
Workbook(Nom du classeur).activate
On error goto 0: goto S2
'En séquence cela signifie que le classeur est déjà ouvert : mais attention
il faut vérifier que le Path est identique
S1:
'Ici tu ouvres le classeur
S2:

E1: resume S1 'Le classeur n'est pas ouvert

J a c q u e s

"GGAL" a écrit dans le message de
news:
Bonjour,

J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs
situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains
classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après
coup.

Merci d'avance,

Ggal

Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub



Avatar
GGAL
Merci de la réponse, mais je ne vois pas très bien où placer ces étiquettes
dans mon cas.
GGal


Bonjour GGAL

Plusieurs solutions :

La plus simple peut être est de faire, avant chaque ouverture :
On Error goto E1
Workbook(Nom du classeur).activate
On error goto 0: goto S2
'En séquence cela signifie que le classeur est déjà ouvert : mais attention
il faut vérifier que le Path est identique
S1:
'Ici tu ouvres le classeur
S2:

E1: resume S1 'Le classeur n'est pas ouvert

J a c q u e s

"GGAL" a écrit dans le message de
news:
Bonjour,

J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs
situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains
classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après
coup.

Merci d'avance,

Ggal

Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub







Avatar
Frédéric Sigonneau
Pas vraiment testé, juste pour l'idée :

'========================= Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'==========================
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr

Bonjour,

J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.

Merci d'avance,

Ggal

Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub


Avatar
GGAL
Non ça ne marche pas.
On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est
ouvert, même message.
Ggal


Pas vraiment testé, juste pour l'idée :

'========================= > Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'========================== >
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr

Bonjour,

J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.

Merci d'avance,

Ggal

Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub





Avatar
Frédéric Sigonneau
Comme je l'avais dit, peu testé. J'avais oublié de désactivé l'instruction
initiale d'ouverture des classeurs. Ça devrait aller mieux comme ça :

'========================= Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
' Workbooks.Open f1 '<<<<<<<<< bis repetita non placent
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'==========================
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr

Non ça ne marche pas.
On me propose de rouvrir le fichier alors qu'il était fermé. Et quand il est
ouvert, même message.
Ggal


Pas vraiment testé, juste pour l'idée :

'========================= >> Sub Test()
Dim Wbk As Workbook, DejaOuvert As Boolean
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
On Error Resume Next
Set Wbk = Workbooks(f1.Name)
If Err <> 0 Then
Workbooks.Open f1
Else
DejaOuvert = True
End If
On Error GoTo 0
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Not DejaOuvert Then Workbooks(f1.Name).Close False
Next
End Sub
'========================== >>
FS
---
Frédéric Sigonneau
http://frederic.sigonneau.free.fr

Bonjour,

J'ai la procédure suivante qui me permet d'ouvrir tous les classeurs situés
dans le répertoire Truc, de façon à remplir un tableau "récap" dans le
classeur actif, puis de les refermer sans enregistrer.
Je souhaiterais que la procédure fonctionne également si certains classeurs
sont déjà ouverts, et dans ce cas les laisser ouverts après copie des
données, et les autres classeurs qui étaient fermés, les refermer après coup.

Merci d'avance,

Ggal

Sub Test()
wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
Workbooks.Open f1
With Workbooks(wb).Sheets("feuil1")
..Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
..Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
Workbooks(f1.Name).Close False
Next
End Sub






Avatar
francois.forcet
Salut à toi
Je te propose ton code modifié ainsi :

wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
For i = 1 To Workbooks.Count
If Workbooks(i).Name = f1.Name Then
Ouvert = 1
Exit For
End If
Next
If Ouvert = 1 Then
Workbooks(i).Activate
Else
Workbooks.Open f1
End If
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Ouvert <> 1 Then
Workbooks(f1.Name).Close False
End If
Ouvert = ""
Next

Celà devrait te convenir
Dis moi !!!!
Avatar
GGAL
La solution de Frédéric fonctionne mieux. Mais celle de François correspond
plus à mes attentes : Si le fichier est ouvert, il reste ouvert. Si le
fichier est fermé, on l'ouvre puis on le ferme sans l'entregistrer.
Toutefois, la variable i apparaît deux fois, d'abord dans le comptage des
classeurs, et ensuite en variable de cellules. J'ai les ai donc séparées en i
et en j.

Merci à tous.

Ggal


Salut à toi
Je te propose ton code modifié ainsi :

wb = ActiveWorkbook.Name
chemin = ActiveWorkbook.Path & "Truc"
Set fs = CreateObject("scripting.filesystemobject")
Set f = fs.getfolder(chemin)
Set fc = f.Files
For Each f1 In fc
For i = 1 To Workbooks.Count
If Workbooks(i).Name = f1.Name Then
Ouvert = 1
Exit For
End If
Next
If Ouvert = 1 Then
Workbooks(i).Activate
Else
Workbooks.Open f1
End If
With Workbooks(wb).Sheets("feuil1")
.Range("a" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("A1")
.Range("b" & 2 + i) = Workbooks(f1.Name).Sheets("récap").Range("B2")
End With
i = i + 1
If Ouvert <> 1 Then
Workbooks(f1.Name).Close False
End If
Ouvert = ""
Next

Celà devrait te convenir
Dis moi !!!!