Fichier déjà ouvert

Le
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
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Jacques ALARDET
Le #6580501
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" 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



GGAL
Le #6582371
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" 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







Frédéric Sigonneau
Le #6583701
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


GGAL
Le #6583681
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





Frédéric Sigonneau
Le #6587581
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






francois.forcet
Le #6587541
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 !!!!
GGAL
Le #6587801
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 !!!!



Publicité
Poster une réponse
Anonyme