Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

46389 / 76732

←次へ　｜　前へ→


	【35315】困りました

たく - 06/2/26(日) 14:34 -


	引用なし

	パスワード

動かすパーツを３つにして
thing1，thing4，thing7を
thing2，thing5，thing8と重なっていたらそのところに
重ならなかったらthing3，thing6，thing9のところに動かそうとしています。

Dim kasanari(j) As Boolean

これ以降の書き方、どうすればいいでしょうか？

Sub check()

'9つのオブジェクトの位置と大きさを求める

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 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

'重なり方の判定

Dim j As Integer

For j = 1 To 3

Dim kasanari(j) As Boolean　

　　　　　　　　　　　　　　　　　
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(j) = True
　　　End If
　　End If
　End If
End If

'重なっているとき

If kasanari(j) 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

Next j

End Sub

0 hits

▼

【35281】貼り付けた画像ファイルを特定セルのみに移動させるには？ たく 06/2/25(土) 12:28