テキストボックスの移動（２）

質問

• 前回の質問に対して、別のシートから複数のシートのテキストボックスを一斉に移動させる方法を知りたいです。
• 前回のプログラムでは、シートごとに位置を指定するボタンを配置していましたが、Sheet5に配置したボタンを使ってSheet1・Sheet2・Sheet3のテキストボックスを一括で移動できるようにしたいです。
• 具体的には、Sheet1・Sheet2・Sheet3に配置されているテキストボックス１をＡ位置とＢ位置に移動させたいです。

回答No.1

nishi6

前回VBAを少し変えました。２箇所のTextBoxの位置は各シートで同一としています。
各TextBoxにはSheet1,2,3に対応してmyText1,myText2,myText3の名前を付けています。
標準モジュールに貼り付けます。

'四角形を動かす(例：四角形は各シートに1個)
Public Sub ShapeMove2()
Const ShpNum = 2 '四角形の個数
Dim ShpTop(2), myShpTop As Double '動かす各位置、表示位置
Dim ShpLeft(2), myShpLeft As Double '動かす各位置、表示位置
ShpTop(1) = 71.25: ShpLeft(1) = 90.75 '***縦・横位置の登録***
ShpTop(2) = 98.25: ShpLeft(2) = 276
Dim ct As Integer 'カウンタ
Dim myShpIdx As Integer '四角形の順序
Dim ws As Integer 'シート

Application.ScreenUpdating = False
'シート1を代表にして今ある位置を調べる
Worksheets("Sheet1").Activate
With ActiveSheet.Shapes("myText1")
myShpTop = .Top '今あった位置
myShpLeft = .Left '今あった位置
myShpIdx = 0
For ct = 1 To ShpNum
If myShpTop = ShpTop(ct) And myShpLeft = ShpLeft(ct) Then
myShpIdx = ct '何番目か探す
End If
Next
'次の場所はどっち？
myShpIdx = myShpIdx + 1
If myShpIdx > ShpNum Then
myShpIdx = 1
End If
End With
'各シートで動かす
For ws = 1 To 3
Worksheets("Sheet" & ws).Activate
With ActiveSheet.Shapes("myText" & ws)
'次の場所にする
.Top = ShpTop(myShpIdx)
.Left = ShpLeft(myShpIdx)
End With
Next
Worksheets("Sheet5").Activate
Application.ScreenUpdating = True
End Sub

シート5のシートモジュールに貼り付けます。
Private Sub CommandButton1_Click()
ShapeMove2
End Sub

もう寝よう・・・

補足

nishi6さん、ありがとうございます。うまくうごきました。

しかし、Ａの位置にする為のボタンと、Ｂの位置にする為のボタンがほしいのですが、宜しくお願いします。
（ボタン名は、位置を表現する物にしてテキストボックスのあるシートを見なくても分かるようにする為）

私も試してみました・・・
現在の位置を調べて、その値を代入させて、文字表示させようとしたのですが、これでは、テキストボックスを微調整したときが、まずいのでやめました。
やはり、位置を指定するボタンが２つあったほうが良さそうなので、宜しくお願いします。