プロが教えるわが家の防犯対策術!

シート内に複数の図形が並んでいます。
その内の3個をマウスで選んで、アクティブ図形のみをVBAで移動させたいのですが、可能でしょうか?

質問者からの補足コメント

  • 以下にあるスクリプトは図形を指定していますが、この部分をマウスで選択した図形全てに…という形にしたいのです。

      補足日時:2016/08/04 16:24
  • ' 上に移動する
    Private Sub CmdUp_Click()
    Dim currTop As Variant
    Dim currLeft As Variant
    ' 図形の現在の図の位置を取得する
    With Sheets("Sheet1").Shapes("fig1")
    currTop = .Top
    currLeft = .Left
    End With
    ' 図形の現在の位置を上に移動する
    ' Top位置を小さくする
    With Sheets("Sheet1").Shapes("fig1")
    .Top = currTop - 10
    .Left = currLeft
    End With
    End Sub

      補足日時:2016/08/04 16:24

A 回答 (2件)

>この部分をマウスで選択した図形全てに…という形にしたいのです。



ふつうは、#1さんの方法で十分だと思うのですが、全体ということになれば、こんな風に変えます。(#1さんのコードをお借りします)


Sub Sample2()
Dim shps As DrawingObjects
Set shps = Selection '別に置き換える必要はないけれど、インテリセンスのため。

With shps.ShapeRange '
  .IncrementTop -10
End With
End Sub
    • good
    • 1
この回答へのお礼

' 上に移動する
Private Sub CmdUp_Click()
Dim currTop As Variant
Dim currLeft As Variant
Dim shps As DrawingObjects
Set shps = Selection
' 図形の現在の図の位置を取得する
'With Sheets("Sheet1").Shapes("fig1")
With shps.ShapeRange
currTop = .Top
currLeft = .Left
End With
' 図形の現在の位置を上に移動する
' Top位置を小さくする
'With Sheets("Sheet1").Shapes("fig1")
With shps.ShapeRange
.Top = currTop - 10
.Left = currLeft
End With
End Sub

・・・とすればよろしかったでしょうか?
実行するとSet shps = Selectionで止まってしまい"型が一致しません"と表示されます。

お礼日時:2016/08/05 15:26

こんな感じでどうですか。



Sub sample()
  
  Dim sh As Shape

  ' 選択した図形を一つずつ処理
  For Each sh In Selection.ShapeRange
    sh.IncrementTop (-10) ' 上へ移動
  Next

End Sub
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています


このQ&Aを見た人がよく見るQ&A