Comment utilliser GetObject pour ne pas ouvrir à chaque fois le fichier cible ?

Bonsoir

J'ai une petite interrogation quant à un programme que je viens de finir ,
pour lequel je m'interroge sur la possibilité de faire une version plus
"light", je veux dire par là , un programme qui, au lieu d'aller chercher
la

valeur d'une dizaine de cellules (toujours les mêmes) dans tous les
fichiers

d'un même dossier, utiliserait la propriété GetObject pour recueillir la
valeur de ces mêmes cellules, sans être obligé d'ouvrir à chaque fois le
fichier. J'ai testé la possibilité d'exploiter cette fonction, via le
l'essai suivant :

If Workbooks("arrêt ZAZA.xls").Sheets(1).Name <> "Salariés" Then
a = GetObject("c:Mes documentsEssaiarrêt
ZAZA.xls").Worksheets(1).Range("J12")
MsgBox (a)
End If

Cela semble OK.
Ce que je n'arrive pas à trouver dans les bouquins que j'ai (VBA pour
Excel/Microapp - VBA pour office/pochemicro) ou sur Excelabo, c'est la
manière de l'exploiter, à savoir : s'il y a une procédure à enregistrer
pour

"fermer" le fichier "consulté", et les limites d'exploitabilité de ce
transfert de données, comment déclarer les variables sachant que, ce que
je

récupère, n'est que texte ou date ou nombre...

Ci-joint la macro que j'ai, et qui tourne...
Vous semble-t-il possible de tirer partie de la propriété GetObject pour
ne

pas ouvrir chaque fichier, et donc gagner en simplicité, donc en
efficacité

et en rapidité ?

Merci à tous

Sub récapitulatif_arrêt_de_T()
' désactive le rafraîchissement de l'écran
Application.ScreenUpdating = False
' déclaration des variables
Dim a(300, 9)
Dim F, chemin As String
Dim b, i, k, lig, n, nl As Long
' efface le contenu de toutes les cellules des 2 feuilles
Sheets(2).Select
Cells.ClearContents
Sheets(1).Select
Cells.ClearContents
' décale la 1ère ligne de copie de 2 lignes
lig = 2
' enregistre le chemin d'accès au fichier
chemin = ActiveWorkbook.Path & ""
' définit le nom du fichier variable du dossier des arrêt de travail
F = Dir$(chemin & "*.xls")
' boucle de recherche des fichiers du dossier des arrêts de travail
Do Until F = ""
' exclut de la boucle le fichier "Récapitulatif" et le fichier
"Formulaire"
If F = "Récapitulatif inter-entreprises des Arrêts de travail.xls" Or
_

F = "Formulaires Arrêt de travail.xls" Then GoTo saute
' ouvre le fichier variable sur la feuille Sommaire
Application.ScreenUpdating = False
Workbooks.Open chemin & F
Application.ScreenUpdating = False
' sélectionne la feuille Sommaire
Sheets(1).Select
' boucle de transfert en fichier temporaire de la ligne 3 à la
dernière
n = 0
For k = 3 To [C65000].End(xlUp).Row
n = n + 1
'copie temporaire en colonne A du non de la société
a(n, 1) = [J1]
'copie temporaire en colonne B à I du reste de l'arrêt
For b = 1 To 8
a(n, b + 1) = Cells(k, b)
Next b
Next
' ferme le fichier variable
Workbooks(ActiveWorkbook.Name).Close savechanges:úlse
' transfert toutes les lignes temporaires sur la feuille En cours
For nl = 1 To n
lig = lig + 1
For k = 1 To 9
Cells(lig, k) = a(nl, k)
Next k
Next nl
' destination d'évitement de la boucle If Then
saute:
' sélectionne le fichier suivant
F = Dir$
Loop
' boucle de sélection des lignes Soldées
lig = 2
n = 0
' boucle de transfert en fichier temporaire de la ligne 3 à la
dernière

For k = [C65000].End(xlUp).Row To 3 Step -1
'détecte les cellules Soldées
If Cells(k, 4) <> "En cours" Then
n = n + 1
'copie temporaire en colonne A à I des données de l'arrêt
For b = 1 To 9
a(n, b) = Cells(k, b)
Next b
' efface la ligne Soldée de la feuille En cours
Rows(k).Select
Selection.Delete Shift:=xlUp
End If
Next
' va sur la feuille Soldé
Sheets(2).Select
' transfère la mémoire provisoire sur la feuille 2
For nl = 1 To n
' sélection de la ligne
lig = lig + 1
' sélection des cellules A à I
For k = 1 To 9
Cells(lig, k) = a(nl, k)
' remplace le statut par un sigle pour les Soldés
If Cells(lig, 5) = "Non cadre" Then
Cells(lig, 5) = "NC"
ElseIf Cells(lig, 5) = "Cadre" Then
Cells(lig, 5) = "C"
ElseIf Cells(lig, 5) = "Cadre dirigeant" Then
Cells(lig, 5) = "CD"
End If
Next k
Next nl
' classe les colonnes A puis B par ordre croissant des lettres
Range("A3", [C65000].End(xlUp)).Select
Selection.Sort key1:=Range("A3"), order1:=xlAscending,
key2:=Range("B3"), order1:=xlAscending
' va sur la feuille En cours
Sheets(1).Select
' remise à zéro des paramètres
n = 0
lig = 2
' boucle de transfert en fichier temporaire de la ligne 3 à la
dernière

For k = 3 To [C65000].End(xlUp).Row
'détecte les cellules En cours
If Cells(k, 4) = "En cours" Then
n = n + 1
'copie temporaire en colonne A à I des données de
l'arrêt
For b = 1 To 9
a(n, b) = Cells(k, b)
Next b
End If
Next
' efface le contenu de toutes les cellules de la feuille En cours
Cells.ClearContents
' transfère la mémoire provisoire sur la feuille 2
For nl = 1 To n
lig = lig + 1
' sélection des cellules A à I
For k = 1 To 9
Cells(lig, k) = a(nl, k)
Next k
Next nl
' classe les colonnes A puis B par ordre croissant des lettres
Range("A3", [C65000].End(xlUp)).Select
Selection.Sort key1:=Range("A3"), order1:=xlAscending,
key2:=Range("B3"), order1:=xlAscending
' réalise le format des cellules des 2 feuilles
For i = 1 To 2
ActiveWorkbook.Sheets(i).Select
' affiche le titre de chaque feuille
If i = 1 Then
Range("B1").Value = "Arrêts de travail en cours"
Else
Range("B1").Value = "Arrêts de travail soldés"
End If
' affiche la date de F1 à I1
Range("F1:G1").Select
ActiveCell.FormulaR1C1 = "Enregistré le"
Range("H1:I1").Select
ActiveCell.FormulaR1C1 = "=TODAY()"
Selection = Selection.Value
' met les titres des 9 cellules de la 2ème ligne
Range("A2").Value = "Entreprise"
Range("B2").Value = "Salarié en arrêt"
Range("C2").Value = "Début d' arrêt"
Range("D2").Value = "Fin d' arrêt"
Range("E2").Value = "Statut"
Range("F2").Value = "Salaire / jour"
Range("G2").Value = "I.J. Cie / jour"
Range("H2").Value = "Nb. de jours"
Range("I2").Value = "I.J. Cie cumulées"
' reproduit en A2 le format de la cellule B2
Range("B2").Select
Selection.Copy
Range("A2").Select
Selection.PasteSpecial Paste:=xlFormats
Application.CutCopyMode = False
Range("A1").Select
With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$2"
End With
ActiveSheet.PageSetup.PrintArea = ""
Next i
' va sur la feuille En cours
Sheets(1).Select
' réactive l'écran
Application.ScreenUpdating = True
End Sub

aller chercher la valeur d'une dizaine de cellules (toujours les mêmes)
dans tous les
fichiers d'un même dossier ....sans être obligé d'ouvrir à chaque fois le
fichier.

Ce que je n'arrive pas à trouver sur Excelabo

Bonsour® Antoine76 avec ferveur ;o))) vous nous disiez :

aller chercher la valeur d'une dizaine de cellules (toujours les mêmes)
dans tous les
fichiers d'un même dossier ....sans être obligé d'ouvrir à chaque fois
le

fichier.

Ce que je n'arrive pas à trouver sur Excelabo

heu ....
http://www.excelabo.net/moteurs/compteclic.php?nomügd-lireferme
http://www.excelabo.net/moteurs/compteclic.php?nom=rd-lireferme
http://www.excelabo.net/xl/fichiers.php#lireferméenbloc

--
;o)))
@+

Les news à la source !!!
news://news.microsoft.com/microsoft.public.fr.excel
et répondez OUI

n'oubliez pas les FAQ :http://www.excelabo.net
http://dj.joss.free.fr/faq.htm
http://www.faqoe.com http://faqword.free.fr

Bonjour,

Exemple simple pour totaliser les factures de classeurs
Facture001.xls,Facture002.xls,...

D E
1 Total Factures
2 1500 12000

http://cjoint.com/?bohCopTET4

Sub RecupPlusieursClasseurs()
ChDir ActiveWorkbook.Path
nf = Dir("Facture0*.xls")
[E2] = 0
Do While nf <> ""
[D2].Formula = "=[" & nf & "]Feuil1!D10"
[E2] = [E2] + [D2]
nf = Dir
ActiveCell.Offset(1, 0).Select
Loop
End Sub

Cordialement JB