| |
▼やっちん さん：ありがとうございます。そうですね。
ＶＢＡはドラッグしたときにイベントは発生しませんよね。
判定ボタンを作っていちいち押すのは面倒です。
何も考えずに作ってしまいました。
アドバイスあったら、お願いします。
少し変えました。
↓
Sub check()
'３つのオブジェクトの位置と大きさを求める
Dim X(1 To 3) As Integer 'X座標
Dim Y(1 To 3) As Integer 'Y座標
Dim W(1 To 3) As Integer '幅
Dim H(1 To 3) As Integer '高さ
Dim i As Integer
Dim kasanari As Boolean
For i = 1 To 3
X(i) = ActiveSheet.Shapes("thing" & i).Left
Y(i) = ActiveSheet.Shapes("thing" & i).Top
W(i) = ActiveSheet.Shapes("thing" & i).Width
H(i) = ActiveSheet.Shapes("thing" & i).Height
Next i
'重なり方の判定
If Y(1) < Y(2) + H(2) Then
If Y(1) + H(1) > Y(2) Then ← + H(1)はいらない？
If X(1) < X(2) + W(2) Then
If X(1) + W(1) > X(2) Then ← + W(1)はいらない？
kasanari = True
End If
End If
End If
End If
'重なっているとき
If kasanari Then
With ActiveSheet.Shapes("thing1")
.Top = Y(2) ← .Top = Y(2) + 1 に変更
.Left = X(2) ← .Left = X(2) + 1 に変更
End With
'重なっていないとき
Else
With ActiveSheet.Shapes("thing1")
.Top = Y(3)
.Left = X(3)
End With
End If
End Sub
|
|
たく
- 06/2/26(日) 1:42 -
