Microsoft 365 Liaison entre deux cellulles dans les deux sens

[Piaf79]

Bonjour le forum,
Je ne sais pas si cela est possible en VBA mais je cherche a créer une liaison entre deux cellules dans les deux sens.
Ex : Feuil1 A1 liée dans les deux sens avec Feuil2 A2 que je modifie la cellule en Feuil1 ou en Feuil2 l'autre est actualisée automatiquement.
Merci d'avance pour vos remarques/retours.
Piaf79

 

[mapomme]

Bonjour @Piaf79,

Dans le module de code de Feuil1, placer le code suivant:

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   If Not Intersect(Range("a1"), Target) Is Nothing Then Feuil2.Range("a2") = Range("a1")
   Application.EnableEvents = True
End Sub

Dans le module de code de Feuil2, placer le code suivant:

Private Sub Worksheet_Change(ByVal Target As Range)
   Application.EnableEvents = False
   If Not Intersect(Range("a2"), Target) Is Nothing Then Feuil1.Range("a1") = Range("a2")
   Application.EnableEvents = True
End Sub

Le "Application.EnableEvents" est présent pour éviter une boucle sans fin si les deux cellules sont les mêmes sur chaque feuille.

 

[Piaf79]

Merci mapomme !
Est-il possible de faire la même chose entre deux classeurs ?
Piaf

 

[patricktoulon]

re
bonjour
oui a condition que les classeurs soient ouverts ! et dans la même instance d'excel
ajouter le test de la présence des classeurs dans la macro événement pour etre sur
donc tu ajoute ça dans le model qui t'a été donné par mapomme

 

[Piaf79]

RE, bonjour patricktoulon,
Oui j'ai vu avec des classeurs ouverts.
Pas d'astuce avec un classeur fermé ? Comme le principe du lien ?

 

[Dranreb]

Bonjour.
À condition aussi que les classeurs soient ouverts, vous pouvez mettre ce code dans toutes les feuilles de tous les classeurs concernées :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim CelJum As Range
   On Error GoTo R
   Set CelJum = Evaluate(Target.Formula)
   Application.EnableEvents = False
   Target.Value = Target.Value
   CelJum.Formula = "=" & Target.Address(External:=True)
   Application.EnableEvents = True
R: End Sub

Mais ça implique une règle d'utilisation strictes. Il n'est permis de mettre pour toute formule dans une cellule quelconque d'une feuille membre du club qu'un simple renvoi vers une seule autre telle cellule, et cette formule est aussitôt remplacée par sa valeur.
Maintenant il serait peut être possible d'ouvrir automatiquement le classeur s'il ne l'est pas …

 

[Piaf79]

Dans mon cas de figure, il n'y a que deux classeurs concernés.
D'où mon souhait de savoir si il existe une possibilité avec un des deux classeurs fermé... avec actualisation lors de l'ouverture suivante.

 

[Dranreb]

Relire ma dernière phrase. Je ne sais pas modifier un classeur fermé.

 

[Dranreb]

Version à tester, qui ouvre si nécessaire le classeur de la cellule liée et le referme à la fin :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Wbk As Workbook, CelJum As Range
   If Target.CountLarge <> 1 Then Exit Sub
   If Not Target.HasFormula Then Exit Sub
   With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
   On Error GoTo E
   If Replace(Target.FormulaR1C1, "'", "") Like "=?*[[]*]*!R#*C#*" Then Set Wbk = Workbooks.Open( _
      Replace(Replace(Split(Mid$(Target.Formula, 2), "]")(0), "'", ""), "[", "\"))
   Set CelJum = Evaluate(Target.Formula)
   Target.Value = Target.Value
   CelJum.Formula = "=" & Target.Address(True, True, xlA1, True)
   If Not Wbk Is Nothing Then Wbk.Close SaveChanges:=True
E: With Application: .EnableEvents = True: .DisplayAlerts = True: End With
   End Sub

 

[mapomme]

Bonjour @Piaf79, @patricktoulon 🙂, @Dranreb 🙂,

Une autre macro un peu plus longue que toutes les autres.
Pour l'exemple, on a deux classeurs:

1. le premier s'appelle toto.xlsm et se trouve dans c:\tempo1. La cellule à surveiller est la cellule A1 de la feuille "Feuil1"
2. le second s'appelle tata.xlsm et se trouve dans c:\tempo2. La cellule à surveiller est la cellule A2 de la feuille "Feuil3"

Classeur "toto": Dans l'évènement Change de la feuille "Feuil1", on appelle la procédure MiseAJour() qui se trouve dans module1 du classeur "toto"
Classeur "tata": Dans l'évènement Change de la feuille "Feuil3", on appelle la procédure MiseAJour() qui se trouve dans module1 du classeur "tata"
Les procédures MiseAJour() de chaque fichier ont exactement le même code.
En tête de la procédure MiseAJour(), on définit les constantes: nom complet (avec chemin) des deux fichiers, les feuilles concernées et les cellules concernées.
Si le fichier à mettre à jour n'est pas ouvert, on l'ouvre, on le modifie puis on le referme.

Décompresser le fichier joint sous C:\

 

[Dranreb]

Je pense qu'il y avait une erreur dans ma procédure.
Correction avec demande de confirmation si la formule prend sa valeur d'un classeur fermé :

Option Explicit
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Wbk As Workbook, NomComplet As String, CelJum As Range
   If Target.CountLarge <> 1 Then Exit Sub
   If Not Target.HasFormula Then Exit Sub
   With Application: .ScreenUpdating = False: .DisplayAlerts = False: .EnableEvents = False: End With
   On Error GoTo E
   If Replace(Target.FormulaR1C1, "'", "") Like "=?*[[]*]*!R#*C#*" Then
      NomComplet = Replace(Replace(Split(Mid$(Target.Formula, 2), "]")(0), "'", ""), "[", "")
      If MsgBox("Cette valeur vient du classeur suivant :" & vbLf & NomComplet & vbLf _
         & "Avez vous l'intention de la modifier ?", vbExclamation + vbYesNo, _
         "Sélection " & Target.Address(False, False, xlA1, False)) = vbNo Then
         Me.[A1:B1].Select: GoTo E: End If
      Set Wbk = Workbooks.Open(NomComplet)
      End If
   Set CelJum = Evaluate(Target.Formula)
   Target.Value = Target.Value
   CelJum.Formula = "=" & Target.Address(True, True, xlA1, True)
   If Not Wbk Is Nothing Then Wbk.Close SaveChanges:=True
E: With Application: .EnableEvents = True: .DisplayAlerts = True: End With
   End Sub

 

[Piaf79]

@mapomme
Merci pour le fichier .zip cela fonctionne parfaitement.
Dernière question... est il envisageable de partager les deux fichiers via onedrive (via sharepoint) ? J'imaigne qu'il faut modifier les adresses du fichier un et du fichier deux mais la manip est elle possible en ligne ou exclusivement en local ?
Mon idée est de permettre à plusieurs personnes d’accéder aux fichier en même temps.

@Dranred
Merci pour ton code je vais le tester

 

[mapomme]

Re,

Dernière question... est il envisageable de partager les deux fichiers via onedrive (via sharepoint) ? J'imaigne qu'il faut modifier les adresses du fichier un et du fichier deux mais la manip est elle possible en ligne ou exclusivement en local ?

Je n'ai pas encore travaillé en VBA sur un sharepoint ou onedrive. D'autres (j'espère) pourront sans doute t'apporter des éléments de réponse...

 

[Dranreb]

Bonjour.

Mon idée est de permettre à plusieurs personnes d’accéder aux fichier en même temps.

Pourquoi ne dites vous ça que maintenant ?
Il faudrait pratiquement passer par un troisième fichier qui ne resterait jamais ouvert plus d'une demi-seconde.
Ou alors passer par un ou plusieurs fichiers auxiliaires indépendants d'Excel. Ce ne sera pas simple. Les deux fichiers sont en somme des copies-conformes l'un de l'autre ?

 

[Piaf79]

Bonjour,
@Dranreb... tout simplement car je ne l'avais pas anticipé... désole... :-(
Non les deux fichiers ne sont pas des copies conformes l'un de l'autre. Il y a un fichier "client" et un deuxième fichier "synthèse" de plusieurs fichiers clients.
Piaf79