[[20100518184324]]　『オートシェイプの移動』（まま）　ページの最後に飛ぶ

『オートシェイプの移動』（まま）

 オートシェイプの移動をしたいのですが自動記録で試しましたがオートシェイプには個々に番号がありうまくいきません。
ActiveSheet.Shapes("Rectangle 520").Select
    Selection.ShapeRange.IncrementLeft 171.75
    Selection.ShapeRange.IncrementTop -219.75
End Sub
こんな感じですが("Rectangle 520")この部分がランダムの数字でも対応できるコードを
教えてください。マクロは自動記録しか出来ないので宜しくお願いします。

 全部のオートシェイプを選択したいって事でしょうか？？？
　
 SelectAll メソッドが使用できそうですか？
　
 （キリキ）（〃⌒o⌒)b

 すべてです。一度作った物は消し又新たに作成するため番号ががわります。
 SelectAll メソッド教えてください。（まま）

 ヘルプに答えが載ってますよ～♪
　
 （キリキ）（〃⌒o⌒)b

ヘルプ見ても？（まま）

 >ヘルプ見ても？
 何がですか？
 何処がわからないのか、何がわからないのか、、、
　
 ヘルプを見て実際にその処理を行ってみましたか？
 こういった掲示板は、文字だけの世界ですから
 もう少し、具体的にお話ください・・・
　
  （キリキ）（〃⌒o⌒)b

 削除するなら、Selectする必要はないと思いますが・・・。
 どっちにしてもこの場合は、Drawingobjectsを使ったほうが良いです。

 選択するにしても

 Sub test()
    ActiveSheet.DrawingObjects.Select
 End Sub

 これでやったほうが良いと思いますよ！！

 ActiveSheet.Shapes.SelectAll

 これだとアクティブシートにコメントがあると・・・、

 Sub testtest()
    With ActiveSheet
       .TextBoxes.Add 0, 0, 100, 100
       With .Range("A10").AddComment
          .Visible = True
          .Text Text:="ichinose"
       End With
       DoEvents
       MsgBox "Shapes.SelectAllを実行します"
       .Shapes.SelectAll
    End With
 End Sub

 SelectAllでエラーになります。Excel2002で確認

 もっとも削除するなら

 Sub test()
    ActiveSheet.DrawingObjects.delete
 End Sub

 でよいと思いますけどねえ、検討してみてください。

 だからって、Shapeだけにある新しい機能もあるので駄目って訳ではなく
 図形は、DrawingObjects　とShapesをうまく使い分けるのがよさそうですよ！！

 ichinose

 ichinoseさん、ごめんなさい。。。
　
 >オートシェイプの移動をしたいのですが自動記録で試しましたがオートシェイプには個々に番号がありうまくいきません。
 移動とのことだったので、Selectすれば目で見て確認できると思ったのですが。。。
　
 遠回り過ぎましたかね～
　
 （キリキ）（〃⌒o⌒)b

ichinoseさんキリキさん回答すみません。消すのは手動でいいのですがオートシェイプの移動がしたく質問しました。
ActiveSheet.Shapes("Rectangle 520").Select

    Selection.ShapeRange.IncrementLeft 171.75
    Selection.ShapeRange.IncrementTop -219.75
End Sub
こんな感じですが("Rectangle 520")この部分がランダムの数字でも対応できるコードを
教えてください。
宜しくお願いします。（まま）

 ままさん、、、
 せっかく、ichinoseさんがコメントくれたんです。
 試してみてはいかがでしょうか？
　
 移動するためのコードは記録から出来たんですよね？
 >    Selection.ShapeRange.IncrementLeft 171.75
 >    Selection.ShapeRange.IncrementTop -219.75
　
 ishinoseさんが書いてくださっている 
 > 選択するにしても
 > Sub test()
 >    ActiveSheet.DrawingObjects.Select
 > End Sub
　
 これで選択できますよｂ
　
（キリキ）（〃⌒o⌒)b

Sub test()

 >    ActiveSheet.DrawingObjects.Select
 > End Sub
で試しましたら出来ましたがすべてと言ってしまいましたがオートシェイプのみでした。
今度はすべて動いてしまい困りました。オートシェイプのみ動かす手は教えてもらえませんか？（まま）

 >オートシェイプのみ動かす手
 オートシェイプのみ選択なら、

 Sub test()
    Dim obj As Object
    For Each obj In ActiveSheet.DrawingObjects
       If obj.ShapeRange.Type = msoAutoShape Then
          obj.Select False
       End If
    Next
 End Sub

 ichinose

 ichinoseさん最後まで面倒見ていただきありがとうございました。
おかげさまで完成しました。今回は大変ありがとうございました。（まま）

 ichinoseさんありがとう。勉強になりました。　
Sub tests()
   Dim obj As Object
   ActiveCell.Select

   For Each obj In ActiveSheet.DrawingObjects
     ActiveSheet.Shapes.AddShape(msoShapeUpArrow, (obj.Left + obj.Width / 2) _
              - 28, obj.Top + obj.Height, 56.25, 39.75).Select
     Selection.ShapeRange.Fill.ForeColor.SchemeColor = 10

     If obj.ShapeRange.Type = msoAutoShape Then
        MsgBox "現在オートシェイプを選択 オブジェクトネーム　" & obj.Name
     Else
          MsgBox "現在オートシェイプ以外を選択 オブジェクトネーム　" & obj.Name
     End If
     ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Delete
   Next
 End Sub
（vba初心）

コメント返信：

[ 一覧(最新更新順) ]

[[20100518184324]] 『オートシェイプの移動』（まま） ページの最後に飛ぶ

[[20100518184324]]　『オートシェイプの移動』（まま）　ページの最後に飛ぶ