Microsoft 365 Liaison entre deux cellulles dans les deux sens

Piaf79

XLDnaute Junior
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

XLDnaute Barbatruc
Supporter XLD
Bonjour @Piaf79,

Dans le module de code de Feuil1, placer le code suivant:
Code:
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:
Code:
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.
 

Pièces jointes

  • Piaf79- mises à jour croisées- v1.xlsm
    13.9 KB · Affichages: 21

Dranreb

XLDnaute Barbatruc
Bonjour.
À condition aussi que les classeurs soient ouverts, vous pouvez mettre ce code dans toutes les feuilles de tous les classeurs concernées :
VB:
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 …
 

Dranreb

XLDnaute Barbatruc
Version à tester, qui ouvre si nécessaire le classeur de la cellule liée et le referme à la fin :
VB:
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
 
Dernière édition:

mapomme

XLDnaute Barbatruc
Supporter XLD
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:\
 

Pièces jointes

  • Tempo.zip
    32.5 KB · Affichages: 11
Dernière édition:

Dranreb

XLDnaute Barbatruc
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é :
VB:
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

XLDnaute Junior
@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

XLDnaute Barbatruc
Supporter XLD
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

XLDnaute Barbatruc
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 ?
 

Discussions similaires

Statistiques des forums

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