-PR-
解決
済み

テキストボックスの移動(2)

  • すぐに回答を!
  • 質問No.86955
  • 閲覧数102
  • ありがとう数1
  • 気になる数0
  • 回答数4
  • コメント数0

お礼率 59% (116/195)

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

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



前回のURL → http://oshiete1.goo.ne.jp/kotaeru.php3?q=85846
通報する
  • 回答数4
  • 気になる
    質問をブックマークします。
    マイページでまとめて確認できます。

質問者が選んだベストアンサー

  • 回答No.4
レベル13

ベストアンサー率 68% (791/1163)

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

これ位しか思いつきませんね・・・・
お礼コメント
rurucom

お礼率 59% (116/195)

OKです。ありがとうございました。うまくいきました。
ところで、nishi6さん! テキストボックスに値を入れる(3)を質問させてもらったrurucomですが、質問1)2)3)はしばらくお待ちください!はどうなりましたでしょうか?催促してすみません!そちらの方もよろしくお願いします。
投稿日時 - 2001-06-10 11:28:23
-PR-
-PR-

その他の回答 (全3件)

  • 回答No.1
レベル13

ベストアンサー率 68% (791/1163)

前回VBAを少し変えました。2箇所のTextBoxの位置は各シートで同一としています。 各TextBoxにはSheet1,2,3に対応してmyText1,myText2,myText3の名前を付けています。 標準モジュールに貼り付けます。 '四角形を動かす(例:四角形は各シートに1個) Public Sub ShapeMove2() Const ShpNum = 2 ...続きを読む
前回VBAを少し変えました。2箇所の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

もう寝よう・・・
補足コメント
rurucom

お礼率 59% (116/195)

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

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

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


  • 回答No.2
レベル13

ベストアンサー率 68% (791/1163)

少し手を入れました。 標準モジュールに貼り付けます。 'TextBoxにはSheet1,2,3に対応して、 'myText1,myText2,myText3の名前を付けています '四角形を動かす(例:四角形は各シートに1個) 引数に位置を示す値をセット Public Sub ShapeMove3(Ichi As Integer) Dim ShpTop( ...続きを読む
少し手を入れました。

標準モジュールに貼り付けます。
'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

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

Private Sub CommandButton3_Click() 'B位置へ
ShapeMove3 2
End Sub
補足コメント
rurucom

お礼率 59% (116/195)

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

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

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

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

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

と 言う内容ですが、できますか?
もし、ややこしいようでなければ宜しくお願いします。
投稿日時 - 2001-06-08 22:48:56
  • 回答No.3
レベル13

ベストアンサー率 68% (791/1163)

書いてみました。ユーザーフォームを使えば、また違ったものになるでしょう。今のままでは作りがダブっていますね。 シート1~3に spnLeft: 左右用スピンボタン、spnTop: 上下用スピンボタン cmdInitialize:初期化用ボタンを配置(同名) 左右初期値用セル(iLftj)、左右増分用セル(dLftj) 上下初期値用セル(iTopj)、上下増分用セル(dTopj)の名前を付ける ...続きを読む
書いてみました。ユーザーフォームを使えば、また違ったものになるでしょう。今のままでは作りがダブっていますね。

シート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

これ以上は短くならなかった。
補足コメント
rurucom

お礼率 59% (116/195)

nishi6さん動きましたよー すごいですねー! あとひとつ質問させてください。微調整のボタンを押したとき、テキストボックスが一番左に行ってしまうのですがどうしてでしょうか?
よろしくお願いします。
投稿日時 - 2001-06-09 22:36:07
このQ&Aで解決しましたか?
関連するQ&A
-PR-
-PR-
このやり方知ってる!同じこと困ったことある。経験を教えて!
このQ&Aにはまだコメントがありません。
あなたの思ったこと、知っていることをここにコメントしてみましょう。

その他の関連するQ&A、テーマをキーワードで探す

キーワードでQ&A、テーマを検索する
-PR-
-PR-
-PR-

特集


関連するQ&A

-PR-

ピックアップ

-PR-
ページ先頭へ