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

質問

前回、質問しましたが、回答いただいたプログラムで、別のシートから複数のシートのテキストボックスの移動を移動させたいのですが・・・

たとえば、Sheet1・Sheet2・Sheet3にテキストボックス１が配置してあって、Ａ位置とＢ位置に動くようにしてあります。
前回のプログラムでは、各シートに位置を指定するボタンが配置してありましたが、このボタンをSheet5に配置して、Sheet1・Sheet2・Sheet3の各テキストボックス１が一斉に動くようにしたいのですがよろしくお願いします。

前回のURL　→　http://oshiete1.goo.ne.jp/kotaeru.php3?q=85846

回答No.4

nishi6 · ベストアンサー

各シートのセル（範囲名がiLft1、iLft2やiLft3）に同じ数値が入っているでしょうか。初期位置を表していて自分で入力しておく必要があります。（iTop1等も同じです）

これ位しか思いつきませんね・・・・

お礼

ＯＫです。ありがとうございました。うまくいきました。
ところで、nishi6さん！　テキストボックスに値を入れる（３）を質問させてもらったrurucomですが、質問１）２）３）はしばらくお待ちください！はどうなりましたでしょうか？催促してすみません！そちらの方もよろしくお願いします。

回答No.3

nishi6

書いてみました。ユーザーフォームを使えば、また違ったものになるでしょう。今のままでは作りがダブっていますね。

シート1～3に
spnLeft: 左右用スピンボタン、spnTop: 上下用スピンボタン
cmdInitialize：初期化用ボタンを配置(同名)
左右初期値用セル(iLftj)、左右増分用セル(dLftj)
上下初期値用セル(iTopj)、上下増分用セル(dTopj)の名前を付ける。
()は範囲名で<j>はシート番号と同じにする。
図形は1ピクセル単位で動きます。そのまま保存すれば状況は記憶されています。

下をシート1～3の各シートモジュールに貼り付ける
dLft1やdTop1の<1>はシートにあわせて<2>、<3>に変える。
Private Sub spnLeft_SpinDown() '左右方向の微調整（マイナス）
Range("dLft1") = Range("dLft1") - 0.75: move_Lft Range("dLft1")
End Sub

Private Sub spnLeft_SpinUp() '左右方向の微調整（プラス）
Range("dLft1") = Range("dLft1") + 0.75: move_Lft Range("dLft1")
End Sub

Private Sub spnTop_SpinDown() '上下方向の微調整（マイナス）
Range("dTop1") = Range("dTop1") + 0.75: move_Top Range("dTop1")
End Sub

Private Sub spnTop_SpinUp() '上下方向の微調整（プラス）
Range("dTop1") = Range("dTop1") - 0.75: move_Top Range("dTop1")
End Sub

Private Sub cmdInitialize_Click() '初期化
Range("dLft1") = 0: move_Lft Range("dLft1")
Range("dTop1") = 0: move_Top Range("dTop1")
End Sub

標準モジュールに貼り付ける
Public Sub move_Lft(dLft) '左右方向の微調整
Dim st As Integer 'シートカウンタ
For st = 1 To 3
With Worksheets("Sheet" & st)
.Range("dLft" & st) = dLft
.Shapes("myText1").Left = .Range("iLft" & st) + .Range("dLft" & st)
End With
Next
End Sub

Public Sub move_Top(dTop) '上下方向の微調整
Dim st As Integer 'シートカウンタ
For st = 1 To 3
With Worksheets("Sheet" & st)
.Range("dTop" & st) = dTop
.Shapes("myText1").Top = .Range("iTop" & st) + .Range("dTop" & st)
End With
Next
End Sub

これ以上は短くならなかった。

補足

nishi６さん動きましたよー　すごいですねー！　あとひとつ質問させてください。微調整のボタンを押したとき、テキストボックスが一番左に行ってしまうのですがどうしてでしょうか？
よろしくお願いします。

回答No.2

nishi6

少し手を入れました。

標準モジュールに貼り付けます。
'TextBoxにはSheet1,2,3に対応して、
'myText1,myText2,myText3の名前を付けています
'四角形を動かす(例：四角形は各シートに1個) 引数に位置を示す値をセット
Public Sub ShapeMove3(Ichi As Integer)
Dim ShpTop(2) As Double '動かす各位置、表示位置
Dim ShpLeft(2) As Double '動かす各位置、表示位置
ShpTop(1) = 71.25: ShpLeft(1) = 90.75 '***縦・横位置の登録***
ShpTop(2) = 98.25: ShpLeft(2) = 276
Dim ws As Integer 'シート

Application.ScreenUpdating = False
'各シートで動かす
For ws = 1 To 3
Worksheets("Sheet" & ws).Activate
With ActiveSheet.Shapes("myText" & ws)
'次の場所にする
.Top = ShpTop(Ichi)
.Left = ShpLeft(Ichi)
End With
Next
Worksheets("Sheet5").Activate
Application.ScreenUpdating = True
End Sub

下記はシート５のシートモジュールに貼り付けます。
Private Sub CommandButton2_Click() 'A位置へ
ShapeMove3 1
End Sub

Private Sub CommandButton3_Click() 'B位置へ
ShapeMove3 2
End Sub

補足

nishi6さ～ん！完璧OKです！ありがとうございます。

それと、またまた贅沢なんですが・・・

Sheet1～Sheet3に、スピンボックスを2個配置（上下用、左右用）してテキストボックスの位置をスピンボックスをクリックする事で、微調整させたいのですが、出来ますか？
移動は、±0.1ずつ上下左右に動くようにして、その移動値をセルかコントロールボックスかに表示させるようにしたい。

この微調整は、Sheet1～3のどこのSheetでしても、全部のシートに反映するようにさせたい。

更に、リセットボタン（別に配置）を押したら最初の位置に戻る。
更に、ファイルを閉じるときは、微調整量を覚えていて、次に開いたときには、調整後の状態で開く。

と 言う内容ですが、できますか？
もし、ややこしいようでなければ宜しくお願いします。

回答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さん、ありがとうございます。うまくうごきました。

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

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