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

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

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

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

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

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

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

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

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


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

'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

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

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

'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