Lire les données d'un classeur fermé

wtd fy

XLDnaute Nouveau
Bonjour Mesdames et Messieurs!

Je dois produire une synthèse de plusieurs classeurs sources. La synthèse sera située dans le même répertoire que les fichiers sources.
La synthèse doit être automatisée, c'est-à-dire que la saisie du nom d'un fichier source en colonne A doit déclencher le remplissage automatique des autres colonnes (de B à L).
Ce fichier de synthèse détient une seule ligne par fichier source et doit être capable de lire ces fichiers sources lorsqu'ils sont fermés.

Veuillez trouver ci-joint La synthèse, ainsi que 2 exemplaires de fichier source.

Etant débutant avec Excel, je ne sais pas trop comment m'y prendre...

Est-ce qu'il y a une âme charitable qui serait capable de m'aider sur le sujet svp ? ^^
 

Pièces jointes

  • SynthèseTest.xls
    26 KB · Affichages: 27
  • Source1_ProjetBeta_v1.xls
    26.5 KB · Affichages: 26
  • Source2_ProjetBeta_v2.xls
    26.5 KB · Affichages: 31

Nairolf

XLDnaute Accro
Salut,

Ce que tu souhaites faire, sans être insurmontable, n'est pas si simple que ça, surtout pour un novice.

Avec une série de fonctions imbriquées, à ma connaissance, il est possible de répondre à ta demande, mais avec l'obligation que les fichiers soient ouverts (à cause de la fonction INDIRECT() que j'utiliserais dans ce cas).

Pour répondre plus précisément à ta demande, il faudrait utiliser du code vba (code des macros Excel), mais si tu n'en connais pas sons usage, tu va avoir du mal à adapter les bouts de codes que nous pourrions te fournir (à moins qu'une âme très charitable ne fasse tout le travail et soit à ta disposition pour adapter au mieux à ton besoin).

Je peux te proposer une solution avec la première méthode si le fait d'ouvrir tous les fichiers sources est tout de même faisable.
 

wtd fy

XLDnaute Nouveau
Salut !

Bon je ne suis pas complètement novice on va dire que je suis novice - avancé... j'ai récupéré le code de la fonction Indirect.ext() (même chose qu'indirect() mais pour les fichiers fermés) puis j'ai mélangé cette fonction à pas mal de formules imbriquées pour parvenir à mes fins, ceci étant dit j'ai eu un gros problème de temps de chargements : ils étaient tellement longs et intempestifs qu'Excel était à la limite de l'inutilisable.
Je pense que cela était dû au fait que le fonction Indirect.ext() a été développée afin de chercher la valeur d'une cellule mais qu'elle est trop "lourde" pour l'imbriquer dans des formules de calcul un peu complexes (je ne pense pas que ça soit à cause de mon pc, à moins qu'il soit nécessaire d'avoir une vraie machine de guerre pour faire tourner certaines formules Excel)...
Je joins le code d'Indirect.ext(), peut-être que vous comprendrez mieux son fonctionnement que moi et qu'il est tout de même possible de l'utiliser dans de bonnes conditions.

Désolé mais la synthèse doit obligatoirement pouvoir lire les fichiers sources lorsqu'ils sont fermés... Malheureusement...

Donc tu as raison je vais devoir faire du VBA :/ J'ai quelques notions qui, j'espère, me permettront d'adapter les quelques bouts de code que vous êtes susceptible de me communiquer...
 

Pièces jointes

  • CodeFonction_Indirect.ext().txt
    6.5 KB · Affichages: 29

job75

XLDnaute Barbatruc
Bonjour,

Dans le fichier de synthèse mettre cette macro dans le code de la feuille :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim chemin$, f$, r As Range, x$
chemin = ThisWorkbook.Path & "\"
f = "Feuil1" 'à adapter
Set r = Intersect(Target, Range("A2:A" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
For Each r In r
  r(1, 2).Resize(, 10) = ""
  If Dir(chemin & r & ".xls") <> "" Then
    x = "'" & chemin & "[" & r & ".xls]" & f & "'!"
    r(1, 3) = ExecuteExcel4Macro(x & "R2C3") + ExecuteExcel4Macro(x & "R5C3") + ExecuteExcel4Macro(x & "R8C3")
    r(1, 4) = ExecuteExcel4Macro(x & "R3C3") + ExecuteExcel4Macro(x & "R6C3") + ExecuteExcel4Macro(x & "R9C3")
    r(1, 5) = ExecuteExcel4Macro(x & "R4C3") + ExecuteExcel4Macro(x & "R7C3") + ExecuteExcel4Macro(x & "R10C3")
    r(1, 6) = ExecuteExcel4Macro(x & "R2C4") + ExecuteExcel4Macro(x & "R5C4") + ExecuteExcel4Macro(x & "R8C4")
    r(1, 7) = ExecuteExcel4Macro(x & "R3C4") + ExecuteExcel4Macro(x & "R6C4") + ExecuteExcel4Macro(x & "R9C4")
    r(1, 8) = ExecuteExcel4Macro(x & "R4C4") + ExecuteExcel4Macro(x & "R7C4") + ExecuteExcel4Macro(x & "R10C4")
    r(1, 9) = ExecuteExcel4Macro(x & "R2C5") + ExecuteExcel4Macro(x & "R5C5") + ExecuteExcel4Macro(x & "R8C5")
    r(1, 10) = ExecuteExcel4Macro(x & "R3C5") + ExecuteExcel4Macro(x & "R6C5") + ExecuteExcel4Macro(x & "R9C5")
    r(1, 11) = ExecuteExcel4Macro(x & "R4C5") + ExecuteExcel4Macro(x & "R7C5") + ExecuteExcel4Macro(x & "R10C5")
    r(1, 2) = r(1, 3) + r(1, 6) + r(1, 9)
  End If
Next
End Sub
Puis en colonne A entrer les noms des fichiers sources, sans l'extension (.xls).

A+
 

job75

XLDnaute Barbatruc
Re,

Si de plus on veut que le fichier de synthèse soit mis à jour si l'on modifie un fichier source, mettre dans ThisWorkbook :
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim chemin$, f$, r As Range, x$
chemin = ThisWorkbook.Path & "\"
f = "Feuil1" 'à adapter
Set r = Intersect(Target, Range("A2:A" & Rows.Count), Me.UsedRange)
If r Is Nothing Then Exit Sub
Application.ScreenUpdating = False
r.Columns(2).Resize(, 10) = "" 'RAZ
For Each r In r
  If Dir(chemin & r & ".xls") <> "" Then
    x = "'" & chemin & "[" & r & ".xls]" & f & "'!"
    r(1, 3) = ExecuteExcel4Macro(x & "R2C3") + ExecuteExcel4Macro(x & "R5C3") + ExecuteExcel4Macro(x & "R8C3")
    r(1, 4) = ExecuteExcel4Macro(x & "R3C3") + ExecuteExcel4Macro(x & "R6C3") + ExecuteExcel4Macro(x & "R9C3")
    r(1, 5) = ExecuteExcel4Macro(x & "R4C3") + ExecuteExcel4Macro(x & "R7C3") + ExecuteExcel4Macro(x & "R10C3")
    r(1, 6) = ExecuteExcel4Macro(x & "R2C4") + ExecuteExcel4Macro(x & "R5C4") + ExecuteExcel4Macro(x & "R8C4")
    r(1, 7) = ExecuteExcel4Macro(x & "R3C4") + ExecuteExcel4Macro(x & "R6C4") + ExecuteExcel4Macro(x & "R9C4")
    r(1, 8) = ExecuteExcel4Macro(x & "R4C4") + ExecuteExcel4Macro(x & "R7C4") + ExecuteExcel4Macro(x & "R10C4")
    r(1, 9) = ExecuteExcel4Macro(x & "R2C5") + ExecuteExcel4Macro(x & "R5C5") + ExecuteExcel4Macro(x & "R8C5")
    r(1, 10) = ExecuteExcel4Macro(x & "R3C5") + ExecuteExcel4Macro(x & "R6C5") + ExecuteExcel4Macro(x & "R9C5")
    r(1, 11) = ExecuteExcel4Macro(x & "R4C5") + ExecuteExcel4Macro(x & "R7C5") + ExecuteExcel4Macro(x & "R10C5")
    r(1, 2) = r(1, 3) + r(1, 6) + r(1, 9)
  End If
Next
End Sub
Fichier joint.

A+
 

Pièces jointes

  • SynthèseTest(1).xls
    83.5 KB · Affichages: 29
Dernière édition:

wtd fy

XLDnaute Nouveau
Merci beaucoup ça marche nickel !
Cependant sur mes fichiers source d'origine je vais chercher des cellules sur deux feuilles distinctes... (chose que je n'avais pas encore précisé)
Comment intégrer cette nouvelle contrainte à ton code ? Tu ajoutes une variable "Feuille" (comme f$) & une autre du genre "Chemin du fichier source avec la feuille incluse" (comme x$) ??

P.S: Si y'a moyen que tu mettes quelques commentaires supplémentaires sur ton code pour ma culture personnelle en VBA, je suis preneur :)
 

job75

XLDnaute Barbatruc
Re,

Avec des tableaux VBA ce sera plus rapide :
Code:
Private Sub Workbook_Activate()
Dim chemin$, f$, r As Range, t, rest(), i&, x$
chemin = ThisWorkbook.Path & "\"
f = "Feuil1" 'à adapter
With Feuil1 'CodeName de la feuille de destination
  Set r = Intersect(.Range("A2:A" & .Rows.Count), .UsedRange)
End With
If r Is Nothing Then Exit Sub
t = r.Resize(, 2) 'au moins 2 éléments
ReDim rest(1 To UBound(t), 1 To 10)
For i = 1 To UBound(t)
  If Dir(chemin & t(i, 1) & ".xls") <> "" Then
    x = "'" & chemin & "[" & t(i, 1) & ".xls]" & f & "'!"
    rest(i, 2) = ExecuteExcel4Macro(x & "R2C3") + ExecuteExcel4Macro(x & "R5C3") + ExecuteExcel4Macro(x & "R8C3")
    rest(i, 3) = ExecuteExcel4Macro(x & "R3C3") + ExecuteExcel4Macro(x & "R6C3") + ExecuteExcel4Macro(x & "R9C3")
    rest(i, 4) = ExecuteExcel4Macro(x & "R4C3") + ExecuteExcel4Macro(x & "R7C3") + ExecuteExcel4Macro(x & "R10C3")
    rest(i, 5) = ExecuteExcel4Macro(x & "R2C4") + ExecuteExcel4Macro(x & "R5C4") + ExecuteExcel4Macro(x & "R8C4")
    rest(i, 6) = ExecuteExcel4Macro(x & "R3C4") + ExecuteExcel4Macro(x & "R6C4") + ExecuteExcel4Macro(x & "R9C4")
    rest(i, 7) = ExecuteExcel4Macro(x & "R4C4") + ExecuteExcel4Macro(x & "R7C4") + ExecuteExcel4Macro(x & "R10C4")
    rest(i, 8) = ExecuteExcel4Macro(x & "R2C5") + ExecuteExcel4Macro(x & "R5C5") + ExecuteExcel4Macro(x & "R8C5")
    rest(i, 9) = ExecuteExcel4Macro(x & "R3C5") + ExecuteExcel4Macro(x & "R6C5") + ExecuteExcel4Macro(x & "R9C5")
    rest(i, 10) = ExecuteExcel4Macro(x & "R4C5") + ExecuteExcel4Macro(x & "R7C5") + ExecuteExcel4Macro(x & "R10C5")
    rest(i, 1) = rest(i, 2) + rest(i, 5) + rest(i, 8)
  End If
Next
i = Me.Saved 'mémorisation, pour éviter l'invite à la fermeture
r.Columns(2).Resize(, 10) = rest
Me.Saved = i
End Sub
Fichier (2).

A+
 

Pièces jointes

  • SynthèseTest(2).xls
    82.5 KB · Affichages: 27
Dernière édition:

job75

XLDnaute Barbatruc
Bonjour wtd fy, le forum,

Dans ce fichier (3) la colonne A (liste des fichiers) est renseignée automatiquement :
Code:
Private Sub Workbook_Activate()
Dim chemin$, f$, fich$, i&, a$(), s As Boolean, t(), x$
chemin = ThisWorkbook.Path & "\"
f = "Feuil1" 'à adapter
fich = Dir(chemin & "*.xls")
Application.ScreenUpdating = False
While fich <> ""
  If fich <> Me.Name Then
    i = i + 1
    ReDim Preserve a(1 To i)
    a(i) = Left(fich, Len(fich) - 4)
  End If
  fich = Dir
Wend
With Feuil1 'CodeName de la feuille de destination
  s = Me.Saved 'mémorisation, pour éviter l'invite à la fermeture
  .Rows("2:" & .Rows.Count).Delete 'RAZ
  If i Then
    ReDim t(1 To UBound(a), 1 To 10)
    For i = 1 To UBound(a)
      x = "'" & chemin & "[" & a(i) & ".xls]" & f & "'!"
      t(i, 2) = ExecuteExcel4Macro(x & "R2C3") + ExecuteExcel4Macro(x & "R5C3") + ExecuteExcel4Macro(x & "R8C3")
      t(i, 3) = ExecuteExcel4Macro(x & "R3C3") + ExecuteExcel4Macro(x & "R6C3") + ExecuteExcel4Macro(x & "R9C3")
      t(i, 4) = ExecuteExcel4Macro(x & "R4C3") + ExecuteExcel4Macro(x & "R7C3") + ExecuteExcel4Macro(x & "R10C3")
      t(i, 5) = ExecuteExcel4Macro(x & "R2C4") + ExecuteExcel4Macro(x & "R5C4") + ExecuteExcel4Macro(x & "R8C4")
      t(i, 6) = ExecuteExcel4Macro(x & "R3C4") + ExecuteExcel4Macro(x & "R6C4") + ExecuteExcel4Macro(x & "R9C4")
      t(i, 7) = ExecuteExcel4Macro(x & "R4C4") + ExecuteExcel4Macro(x & "R7C4") + ExecuteExcel4Macro(x & "R10C4")
      t(i, 8) = ExecuteExcel4Macro(x & "R2C5") + ExecuteExcel4Macro(x & "R5C5") + ExecuteExcel4Macro(x & "R8C5")
      t(i, 9) = ExecuteExcel4Macro(x & "R3C5") + ExecuteExcel4Macro(x & "R6C5") + ExecuteExcel4Macro(x & "R9C5")
      t(i, 10) = ExecuteExcel4Macro(x & "R4C5") + ExecuteExcel4Macro(x & "R7C5") + ExecuteExcel4Macro(x & "R10C5")
      t(i, 1) = t(i, 2) + t(i, 5) + t(i, 8)
    Next
    .[A2].Resize(UBound(a)) = Application.Transpose(a)
    .[B2].Resize(UBound(a), 10) = t
  End If
  .Columns.AutoFit 'ajustement largeur
  Me.Saved = s
End With
End Sub
Bien sûr dans le répertoire il ne doit pas y avoir d'autres fichiers .xls que ceux concernés.

Bonne journée.
 

Pièces jointes

  • SynthèseTest(3).xls
    75.5 KB · Affichages: 29

Lone-wolf

XLDnaute Barbatruc
Le contraire m'aurait étonné ;). No problems.

Bein, à 54 ans il est difficile de comprendre sans avoir d'explications. Et immagine les 10aines de questions que je devrait poser et que vous devrez me répondre??? C'est très compliqué. :oops::(
 

wtd fy

XLDnaute Nouveau
Bonjour,

Merci encore pour ton aide précieuse.
J'ai fais quelques modif' sur ton code : j'ai modifié l'extension des fichiers sources en .xlsx & J'ai décalé les résultats de la synthèse.
Du coup j'ai un petit problème : Les valeurs sur la dernière colonne de la synthèse restent figées ... porque ?
Si mes explications ne sont pas très claires tu comprendras sûrement avec le fichier ci-joint.

Bien cordialement.
 

Pièces jointes

  • SynthèseTest_GB2.xlsm
    18.8 KB · Affichages: 26

Discussions similaires

  • Question
Microsoft 365 XLOOKUP
Réponses
8
Affichages
368

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof