Macro : formule avec un autre classeur

Résolu/Fermé
cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016 - 30 mai 2016 à 17:25
cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016 - 1 juin 2016 à 09:35
Bonjour,

J'ai une macro dans laquelle je cherche à intégrer une formule avec un classeur qui seront dans le même répertoire

mais voilà je n'y arrive pas, j'arrive à faire en sorte d'avoir un pop up qui s'ouvre me demandant le liens mais cela ne fonctionne pas

à noter : le nom du classeur où se trouve les données n'aura pas un nom fixe complet mais il contiendra toujours le mot organigrammes
idéalement il faudrait que ce classeur reste fermé ou alors en lecture seule

lien classeur où le calcul devra apparaître : http://www.cjoint.com/c/FEEpuFiSdqw
lien du classeur où il faut aller chercher les données de calculs : http://www.cjoint.com/c/FEEpvVx3iCw

je pensais commencer mon code comme cela mais je suis perdue
' calcul de la fiche de poste selon les données de la consolidation des organigrammes
Nom_classeur = ActiveWorkbook.Name
NomFichier = "*organigrammes*.xls*"
Repertoire = ThisWorkbook.Path
Chemin = Repertoire & NomFichier

Dim lWorkbook As Workbook
Dim lFound As Boolean
'vérification si fichier ouvert
lFound = False
For Each lWorkbook In Workbooks
If lWorkbook.Name = NomFichier Then
lFound = True
Exit For
End If
Next

If lFound = False Then
If Dir(Chemin) <> "" Then

Workbooks.Open Filename:=Chemin, ReadOnly:=True
End If
End If


merci pour vos lumières et votre aide
A voir également:

2 réponses

thev Messages postés 1943 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 14 janvier 2025 697
30 mai 2016 à 23:11
Bonjour,

Cela devrait mieux marcher


Sub ImporterOrganigrammes()

'Déclaration variable chemin et nom en texte
Dim Repertoire As String, Fichierorga As String

'Suppression alertes
Application.DisplayAlerts = False

'Définition contenu variable
Repertoire = ThisWorkbook.Path & "\"
Fichierorga = Dir(Repertoire & "*organigrammes.*")
Fichierorga = "[" & Fichierorga & "]Cumul"

'De la feuille 1 du fichier source
With ficheP
'insertion des formules pour B7 à J26
.Range("B7:J26").FormulaR1C1 = _
"=SUMPRODUCT((" & Fichierorga & "!R2C4:R2C72=R6C)*(" & Fichierorga & "!R3C4:R3C72= RC1)*(OFFSET(" & Fichierorga & "!R3C4,MATCH(R4C2," & Fichierorga & "!R4C3:R400C3, 0),,,69)))"
End With

End Sub

 
1
cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016
31 mai 2016 à 10:14
bonjour

merci pour la réponse et pour l'aide. Je viens de tester et j'ai une erreur 1004 "erreur définie par l'application ou l'objet" au niveau de la formule
0
thev Messages postés 1943 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 14 janvier 2025 697 > cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016
Modifié par thev le 31/05/2016 à 14:04
Le code ci-dessous devrait fonctionner mais tu dois savoir qu'en mettant des fonctions comportant des liaisons avec un autre classeur, ce dernier doit nécessairement être ouvert pour que le résultat soit correct. Si le classeur " organigrammes" est fermé, tu auras toujours "#Valeur".
Pour qu'une liaison fonctionne classeur fermé, les formules correspondantes ne doivent pas faire appel à une fonction.
Voir ma proposition ci-dessous après modification de ton code, pour résoudre ce cas.


Sub ImporterOrganigrammes()

'Déclaration variable chemin et nom en texte
Dim Repertoire, Fichierorga As String
Dim classeur_orga As Workbook

'Suppression alertes
Application.DisplayAlerts = False

'Définition contenu variable
Repertoire = ThisWorkbook.Path & "\"
Fichierorga = Dir(Repertoire & "*organigrammes.*")

'Ouverture classeur organigrammes
Workbooks.Open Filename:=Repertoire & Fichierorga, ReadOnly:=True
Set classeur_orga = ActiveWorkbook

'De la feuille 1 du fichier source
Fichierorga = "[" & Fichierorga & "]Cumul"
With ficheP
'insertion des formules pour B7 à J26
.Range("B7:J26").FormulaR1C1 = _
"=SUMPRODUCT((" & Fichierorga & "!R2C4:R2C72=R6C)*(" & Fichierorga & "!R3C4:R3C72= RC1)*(OFFSET(" & Fichierorga & "!R3C4,MATCH(R4C2," & Fichierorga & "!R4C3:R400C3, 0),,,69)))"
End With
ThisWorkbook.Activate
Calculate

'Fermeture classeur organigrammes
classeur_orga.Close

End Sub



Une fois la liaison établie, je te conseille donc d'ouvrir systématiquement le classeur "organigrammes" en fenêtre cachée via ce code :

Private Sub Workbook_Open()

' ouverture cachée du classeur organigrammes
Workbooks.Open Filename:=ThisWorkbook.LinkSources(xlExcelLinks)(1), ReadOnly:=True
ActiveWindow.Visible = False

End Sub
0
cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016 > thev Messages postés 1943 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 14 janvier 2025
31 mai 2016 à 14:43
merci pour ton aide. du coup je viens de comprendre pourquoi cela ne fonctionne pas. j'ai des formules dans l'onglet où ma sommeprod va chercher.

je vais corriger ça en essayant de faire une formule via ma feuille de conso d'organigrammes.

en tout cas je te remercie beaucoup car ton m'aide m'a bien éclairé :)
0
cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016
Modifié par cooljuly le 31/05/2016 à 16:16
du coup maintenant c'est ma nouvelle sommeprod qui ne fonctionne pas
=SOMMEPROD(('[Consolidation des organigrammes.xlsm]Consolidation'!$AB1:$AB5000=B4)*('[Consolidation des organigrammes.xlsm]Consolidation'!$AE1:$AE5000=B6)*(DECALER('[Consolidation des organigrammes.xlsm]Consolidation'!$AB1:$AB5000;;EQUIV(A7;'[Consolidation des organigrammes.xlsm]Consolidation'!$F$1:$Y$1;0))))

je pars d'un onglet où il n'y a pas de formule cette fois-ci mais je tombe toujours sur le résultat 0
0
thev Messages postés 1943 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 14 janvier 2025 697 > cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016
Modifié par thev le 31/05/2016 à 16:45
Le problème de calcul de la liaison est relatif à l'emploi des fonctions "sommeprod" et "decaler". L'emploi de ces fonctions nécessite que le classeur lié soit ouvert pour que le calcul fonctionne.
Si tu n'as pas ces fonctions dans la formule du classeur où le calcul doit apparaitre, le calcul fonctionnera avec le classeur lié fermé. Tu dois alors reporter ces fonctions dans le classeur où tu as tes données.
0
thev Messages postés 1943 Date d'inscription lundi 7 avril 2008 Statut Membre Dernière intervention 14 janvier 2025 697
31 mai 2016 à 18:15
J'ai procédé à quelques ajustements

code 1

Private Sub Workbook_Open()

On Error Resume Next
' ouverture cachée du classeur organigrammes
Workbooks.Open Filename:=ThisWorkbook.LinkSources(xlExcelLinks)(1), ReadOnly:=True
If Err.Number = 0 Then ActiveWindow.Visible = False

End Sub


code 2

Sub ImporterOrganigrammes()

'Déclaration variable chemin et nom en texte
Dim Repertoire, Fichierorga As String
Dim classeur_orga As Workbook

'Suppression alertes
Application.DisplayAlerts = False

'Définition contenu variable
Repertoire = ThisWorkbook.Path & "\"
Fichierorga = Dir(Repertoire & "*organigrammes.*")

'Ouverture classeur organigrammes
Workbooks.Open Filename:=Repertoire & Fichierorga, ReadOnly:=True
Set classeur_orga = ActiveWorkbook
ActiveWindow.Visible = False

'De la feuille 1 du fichier source
Fichierorga = "[" & Fichierorga & "]Cumul"
With ficheP
'insertion des formules pour B7 à J26
.Range("B7:J26").FormulaR1C1 = _
"=SUMPRODUCT(('" & Fichierorga & "'!R2C4:R2C72=R6C)*('" & Fichierorga & "'!R3C4:R3C72= RC1)*(OFFSET('" & Fichierorga & "'!R3C4,MATCH(R4C2,'" & Fichierorga & "'!R4C3:R400C3, 0),,,69)))"
End With
ThisWorkbook.Activate
Calculate

'Fermeture classeur organigrammes
classeur_orga.Close

End Sub


ci-joint fichier
https://www.cjoint.com/c/FEFqpKQbvIw



 
0
cooljuly Messages postés 40 Date d'inscription mercredi 23 mars 2016 Statut Membre Dernière intervention 6 septembre 2016
1 juin 2016 à 09:35
c'est super. cela fonctionne.
merci beaucoup
0