| |
1秒間隔で動くようにしてみました。
Timer_Startをスタートのボタンに登録して、
Timer_ENdをエンドのボタンに登録して動かしてみてください。
Option Explicit
Dim X(1 To 9) As Integer 'X座標
Dim Y(1 To 9) As Integer 'Y座標
Dim W(1 To 9) As Integer '幅
Dim H(1 To 9) As Integer '高さ
Dim MyTime As Date
Sub Timer_Start()
Dim i As Integer
For i = 1 To 9
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
MyTime = Now() + TimeValue("00:00:01")
Application.OnTime MyTime, "check"
End Sub
Sub Timer_ENd()
On Error Resume Next
Application.OnTime MyTime, "check", , False
End Sub
Sub check()
Dim kasanari As Boolean
Dim j As Integer
Dim i As Integer
Dim Xx(1 To 3) As Integer 'X座標
Dim Yy(1 To 3) As Integer 'Y座標
For i = 1 To 3
Xx(i) = ActiveSheet.Shapes("thing" & ((i - 1) * 3 + 1)).Left
Yy(i) = ActiveSheet.Shapes("thing" & ((i - 1) * 3 + 1)).Top
Next i
'重なり方の判定
For j = 1 To 3
kasanari = False
If Xx(j) <> X((j - 1) * 3 + 1) Or Yy(j) <> Y((j - 1) * 3 + 1) Then
X((j - 1) * 3 + 1) = Xx(j)
Y((j - 1) * 3 + 1) = Yy(j)
If Y(j * 3 - 2) < Y(j * 3 - 1) + H(j * 3 - 1) Then
If Y(j * 3 - 2) + H(j * 3 - 2) > Y(j * 3 - 1) Then
If X(j * 3 - 2) < X(j * 3 - 1) + W(j * 3 - 1) Then
If X(j * 3 - 2) + W(j * 3 - 2) > X(j * 3 - 1) Then
kasanari = True
End If
End If
End If
End If
'重なっているとき
If kasanari Then
With ActiveSheet.Shapes("thing" & j * 3 - 2)
.Top = Y(j * 3 - 1) + 1
.Left = X(j * 3 - 1) + 1
End With
'重なっていないとき
Else
With ActiveSheet.Shapes("thing" & j * 3 - 2)
.Top = Y(j * 3)
.Left = X(j * 3)
End With
End If
End If
Next j
MyTime = Now() + TimeValue("00:00:01")
Application.OnTime MyTime, "check"
End Sub
|
|
やっちん
- 06/2/26(日) 15:44 -
