- ベストアンサー
テキストボックスの移動（２）
- 前回の質問に対して、別のシートから複数のシートのテキストボックスを一斉に移動させる方法を知りたいです。
- 前回のプログラムでは、シートごとに位置を指定するボタンを配置していましたが、Sheet5に配置したボタンを使ってSheet1・Sheet2・Sheet3のテキストボックスを一括で移動できるようにしたいです。
- 具体的には、Sheet1・Sheet2・Sheet3に配置されているテキストボックス１をＡ位置とＢ位置に移動させたいです。
- みんなの回答 （4）
- 専門家の回答
質問者が選んだベストアンサー
その他の回答 (3)
- nishi6
- ベストアンサー率67% (869/1280)
書いてみました。ユーザーフォームを使えば、また違ったものになるでしょう。今のままでは作りがダブっていますね。 シート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６さん動きましたよー すごいですねー！ あとひとつ質問させてください。微調整のボタンを押したとき、テキストボックスが一番左に行ってしまうのですがどうしてでしょうか？ よろしくお願いします。
- nishi6
- ベストアンサー率67% (869/1280)
少し手を入れました。 標準モジュールに貼り付けます。 '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でしても、全部のシートに反映するようにさせたい。 更に、リセットボタン（別に配置）を押したら最初の位置に戻る。 更に、ファイルを閉じるときは、微調整量を覚えていて、次に開いたときには、調整後の状態で開く。 と 言う内容ですが、できますか？ もし、ややこしいようでなければ宜しくお願いします。
- nishi6
- ベストアンサー率67% (869/1280)
前回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さん、ありがとうございます。うまくうごきました。 しかし、Ａの位置にする為のボタンと、Ｂの位置にする為のボタンがほしいのですが、宜しくお願いします。 （ボタン名は、位置を表現する物にしてテキストボックスのあるシートを見なくても分かるようにする為） 私も試してみました・・・ 現在の位置を調べて、その値を代入させて、文字表示させようとしたのですが、これでは、テキストボックスを微調整したときが、まずいのでやめました。 やはり、位置を指定するボタンが２つあったほうが良さそうなので、宜しくお願いします。
お礼
ＯＫです。ありがとうございました。うまくいきました。 ところで、nishi6さん！ テキストボックスに値を入れる（３）を質問させてもらったrurucomですが、質問１）２）３）はしばらくお待ちください！はどうなりましたでしょうか？催促してすみません！そちらの方もよろしくお願いします。