[ExcelVBA] テキストボックスの連動

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar

アドベントカレンダー 19日目

あるシートにテキストボックスを用意しファイルパスなど設定事項を
入力するよう指定していたら別のシートからも変更できるように
お願いできますか？と、言われたとします。

確かに…
設定だけ、あるシートにまとめておくと管理はしやすいものの
いちいち、そこに移動して入力し、また戻ってくるってのは
いささかめんどくさく感じる時もありますよね。

そういった場合、テキストボックス同士どちらで変更しても
同じ情報となるように細工したくなりますよね。
さてどうします？

具体例として以下のケースに出くわしたとします。
（あくまでも例です）

シートは３つあります。
Aシートにはテキストボックスが３つ。
Bシートにはテキストボックスが２つ。
Cシートにはテキストボックスが１つ。

テキストボックス３については、３つのシートどこからでも操作がしたく
それぞれ同期がとれていてほしいわけです。
テキストボックス２は、２つのシートから操作がしたく
それぞれ同期がとれていてほしいわけです。


何も考えずにストレートにコードを書くとこうなりますね。

view plainprint?

1. 'Sheet Aのモジュール  
2. Private Sub TextBox2_Change()  
3.     ThisWorkbook.Sheets("B").TextBox2.Text = Me.TextBox2.Text  
4. End Sub  
5.   
6. Private Sub TextBox3_Change()  
7.     ThisWorkbook.Sheets("B").TextBox3.Text = Me.TextBox3.Text  
8.     ThisWorkbook.Sheets("C").TextBox3.Text = Me.TextBox3.Text  
9. End Sub  
10.   
11.   
12. 'Sheet Bのモジュール  
13. Private Sub TextBox2_Change()  
14.     ThisWorkbook.Sheets("A").TextBox2.Text = Me.TextBox2.Text  
15. End Sub  
16.   
17. Private Sub TextBox3_Change()  
18.     ThisWorkbook.Sheets("A").TextBox3.Text = Me.TextBox3.Text  
19.     ThisWorkbook.Sheets("C").TextBox3.Text = Me.TextBox3.Text  
20. End Sub  
21.   
22.   
23. 'Sheet Cのモジュール  
24. Private Sub TextBox3_Change()  
25.     ThisWorkbook.Sheets("A").TextBox3.Text = Me.TextBox3.Text  
26.     ThisWorkbook.Sheets("B").TextBox3.Text = Me.TextBox3.Text  
27. End Sub  

'Sheet Aのモジュール
Private Sub TextBox2_Change()
    ThisWorkbook.Sheets("B").TextBox2.Text = Me.TextBox2.Text
End Sub

Private Sub TextBox3_Change()
    ThisWorkbook.Sheets("B").TextBox3.Text = Me.TextBox3.Text
    ThisWorkbook.Sheets("C").TextBox3.Text = Me.TextBox3.Text
End Sub


'Sheet Bのモジュール
Private Sub TextBox2_Change()
    ThisWorkbook.Sheets("A").TextBox2.Text = Me.TextBox2.Text
End Sub

Private Sub TextBox3_Change()
    ThisWorkbook.Sheets("A").TextBox3.Text = Me.TextBox3.Text
    ThisWorkbook.Sheets("C").TextBox3.Text = Me.TextBox3.Text
End Sub


'Sheet Cのモジュール
Private Sub TextBox3_Change()
    ThisWorkbook.Sheets("A").TextBox3.Text = Me.TextBox3.Text
    ThisWorkbook.Sheets("B").TextBox3.Text = Me.TextBox3.Text
End Sub

素直にベタ書きしたところです。
今後拡張された場合、どのテキストボックスがどうなってるか
関係を確認した上でコードを追加する必要が生じます。

そんな面倒臭い書き方はしたくないのでもっと楽するには以下のように書きます。

view plainprint?

1. 'Sheet Aのモジュール  
2. Private Sub TextBox2_Change()  
3.     Call AllSheetTextBoxChange("TextBox2", TextBox2.Value)  
4. End Sub  
5.   
6. Private Sub TextBox3_Change()  
7.     Call AllSheetTextBoxChange("TextBox3", TextBox3.Value)  
8. End Sub  
9.   
10.   
11. 'Sheet Bのモジュール  
12. Private Sub TextBox2_Change()  
13.     Call AllSheetTextBoxChange("TextBox2", TextBox2.Value)  
14. End Sub  
15.   
16. Private Sub TextBox3_Change()  
17.     Call AllSheetTextBoxChange("TextBox3", TextBox3.Value)  
18. End Sub  
19.   
20.   
21. 'Sheet Cのモジュール  
22. Private Sub TextBox3_Change()  
23.     Call AllSheetTextBoxChange("TextBox3", TextBox3.Value)  
24. End Sub  
25.   
26. '↑ある関数に対し所定の書き方を繰り返すのみですね。  
27.   
28. '標準モジュール  
29. Sub AllSheetTextBoxChange(ByVal ControlName As String, ByVal Text As String)  
30.     On Error Resume Next '存在しないテキストボックス名の可能性を考慮  
31.       
32.     ThisWorkbook.Sheets("A").OLEObjects(ControlName).Object.Value = Text  
33.     ThisWorkbook.Sheets("B").OLEObjects(ControlName).Object.Value = Text  
34.     ThisWorkbook.Sheets("C").OLEObjects(ControlName).Object.Value = Text  
35.       
36.     On Error GoTo 0  
37. End Sub  

'Sheet Aのモジュール
Private Sub TextBox2_Change()
    Call AllSheetTextBoxChange("TextBox2", TextBox2.Value)
End Sub

Private Sub TextBox3_Change()
    Call AllSheetTextBoxChange("TextBox3", TextBox3.Value)
End Sub


'Sheet Bのモジュール
Private Sub TextBox2_Change()
    Call AllSheetTextBoxChange("TextBox2", TextBox2.Value)
End Sub

Private Sub TextBox3_Change()
    Call AllSheetTextBoxChange("TextBox3", TextBox3.Value)
End Sub


'Sheet Cのモジュール
Private Sub TextBox3_Change()
    Call AllSheetTextBoxChange("TextBox3", TextBox3.Value)
End Sub

'↑ある関数に対し所定の書き方を繰り返すのみですね。

'標準モジュール
Sub AllSheetTextBoxChange(ByVal ControlName As String, ByVal Text As String)
    On Error Resume Next '存在しないテキストボックス名の可能性を考慮
    
    ThisWorkbook.Sheets("A").OLEObjects(ControlName).Object.Value = Text
    ThisWorkbook.Sheets("B").OLEObjects(ControlName).Object.Value = Text
    ThisWorkbook.Sheets("C").OLEObjects(ControlName).Object.Value = Text
    
    On Error GoTo 0
End Sub

今後拡張したい時は、AllSheetTextBoxChangeにシート名を追加するのみです。
以上

>Blog Top Page >[ExcelVBA] Top Page >[ExcelVBA] ExcelVBA ALL >[ExcelVBA] AdventCalendar