エクセルVBA 双方向での書式のリンク方法

エクセルVBAにて双方向での書式のリンクをさせたいと考えています。
具体的にはセルの背景色の双方向リンク方法について教えていただきたいです。ここで双方向での背景色のリンクとは別々のシート上のセルの背景色をどちら側の変更であっても、もう一方に変更を反映させることです。

【シート１】
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Sheets("Sheet2").Range("$A$1").Value = Sheets("Sheet1").Range("$A$1").Value
Sheets("Sheet2").Range("$A$1").Interior.ColorIndex = Sheets("Sheet1").Range("$A$1").Interior.ColorIndex
End If
End Sub

【シート２】
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Sheets("Sheet1").Range("$A$1").Value = Sheets("Sheet2").Range("$A$1").Value
Sheets("Sheet1").Range("$A$1").Interior.ColorIndex = Sheets("Sheet2").Range("$A$1").Interior.ColorIndex
End If
End Sub

上記のコードを記述しています。値のリンクはできているのですが背景色のリンクがどうしてもうまくできません。どちらかの変更と同時にもう一方の背景色も変更されるようにするにはどうすればよいでしょうか？

どんな方法でもかまいませんのでお詳しい方よろしくお願いします。

No.1 回答者： yorozu_ya 回答日時： 2010/11/21 19:21

提示されたコードで出来るはずです。

どちらかの「値」が変更されれば、値も背景色も変わるはずです。
もしかして、「値」は変えずに背景色だけ変えた場合のことを言ってますか？
「値」が変わらなければイベントは起動されません。
背景色の変化でイベントを起動したいなら、
それを常時監視するような大掛かりな話になります。
そこまでやる価値があるかどうかという話です。
※簡単ではありませんし、好ましくない副作用もあるでしょう。

この回答への補足

迅速な回答ありがとうございます。
上記コードでは値と背景色を変更したとき値しか反映されませんでした。
背景色だけを変更したときは次にもう一方側を変更したときに反映されます。

なぜこのようなタイムラグが起こるのでしょうか？プログラムの動作がよくわかっていないのでもしわかればお教え頂きたいです。よろしくお願いします。

補足日時：2010/11/21 21:47

No.2 回答者： yorozu_ya 回答日時： 2010/11/21 23:43

> なぜこのようなタイムラグが起こるのでしょうか？

タイムラグではありません。
前述したように、「値」が変更されたときしかプログラムが呼ばれないのです。
Change とは、「値」の変更のことで、背景色の変更ではありません。
これは、Excel の仕様です。

この回答への補足

エクセルの仕様上、背景色のリンクをさせることは不可能ということでしょうか？

何か良い方法があればお教えいただきたいです。よろしくお願いします。

補足日時：2010/11/22 11:31

No.3 回答者： mitarashi 回答日時： 2010/11/23 22:25

実用的かどうかは分かりませんが、とにかく目的のシートを見たときに色が変わればいいんでしょ的なコードです。

Usedrange全体を対象にしていますので、スピードは保証の限りではありません。
Workbookモジュールに記述して下さい。ご参考まで。
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Dim myCell As Range
Application.ScreenUpdating = False
Select Case Sh.Name
Case "Sheet1"
For Each myCell In Sh.Range(Sheets("Sheet2").UsedRange.Address).Cells
myCell.Interior.ColorIndex = Sheets("Sheet2").Range(myCell.Address).Interior.ColorIndex
Next myCell
Case "Sheet2"
For Each myCell In Sh.Range(Sheets("Sheet1").UsedRange.Address).Cells
myCell.Interior.ColorIndex = Sheets("Sheet1").Range(myCell.Address).Interior.ColorIndex
Next myCell
End Select
Application.ScreenUpdating = True
End Sub