マウスで選択した図形のみVBAで移動したい。

シート内に複数の図形が並んでいます。
その内の３個をマウスで選んで、アクティブ図形のみを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

No.2 回答者： WindFaller 回答日時： 2016/08/05 01:14

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

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


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

With shps.ShapeRange　'
　 .IncrementTop -10
End With
End Sub

この回答へのお礼

' 上に移動する
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

No.1 回答者： siffon9 回答日時： 2016/08/04 19:40

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

Sub sample()
　　
　　Dim sh As Shape

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

End Sub