[[20110610153435]] 『選択している図形のIndexを取得したい』(x11eUser) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『選択している図形のIndexを取得したい』(x11eUser)

 選択している図形の名前は取得できるのですが、Index番号を取得するには
 VBAでどう記述すればいいのか判りません。
 OSはXP、Excel2003です。どなたかお教えください。

 選択している図形の種類(四角や三角)ごとのIndexなら簡単に
 MsgBox Selection.Index

 でとれるのですが、ShapesコレクションのIndexとなると簡単ではないです。
 エクセルのShapeオブジェクトは色々不親切なので
 たとえばSelectionはShapeオブジェクトじゃなくてDrawingObjectの方になってしまいます。

 なので、同名、同Indexがあっても大丈夫なようにループで探すと

  Sub test()
  Dim a As Object, b As Object
  Dim i As Long

  Set a = Selection
  For i = 1 To ActiveSheet.DrawingObjects.Count
    Set b = ActiveSheet.DrawingObjects.Item(i)
    If a.ShapeRange.AutoShapeType = b.ShapeRange.AutoShapeType And _
       a.Name = b.Name And _
       a.Index = b.Index Then
      MsgBox i
    End If
  Next i
  End Sub

 こんな感じです。
 (momo)


momo様。ありがとうございます。
 この悩みは、今朝教えて頂いたIndex番号を配列に入れて図形を選択する続きの話です。
 条件に合う図形を複数選択したあと、それぞれの図形に対して処置を行いたいと考えています。
 したがって、複数選択した図形の情報を配列に入れようと、
 Dim xShapeTBL()
 Dim xShape
 Dim i As Long
 Dim j As Long
     j = Selection.ShapeRange.Count
     Redim xShapeTBL(j)
     For Each xShape in Selection.ShapeRange
         i = i + 1
         xShapeTBL(i)=xShape.Name
     NEXT
 と組んでいるのですが、この「xShapeTBL(i)=xShape.Name」が同じ名前を複数の図形で持っていると
 xShapeTBL(i)から図形を選択し直したとき、目的と違う図形を拾ってしまいます。
 xShapeTBL(i)=でIndex番号が入れば好都合と思っていたのですが…。
  それと、よくわからないのですが、上記のxShapeのパラメータに"ID"というのがあって、
 これがユニークな値を持っているようですが、この"ID"で選択するようなことは出来るのでしょうか?

 回答が遅くなりました。
 IDは図形の種類を表しているはずです。
 それにIndexのように特定のShapeの指定に使えないので
 ループさせている中でコレクションに保持しつつあとでコレクションをループして処理
 というのが簡単ではないでしょうか?
 該当Shapeを選択状態にしなくて良いのならコメント部分を削除してください。

 また、選択するならコレクションに追加しなくても
 For Each shp In Selection でも良さそうですね。

  Sub XXX()
  Dim xShapeTBL() 'Selectしなければ不要
  Dim myColl As New Collection
  Dim shp As Shape
  Dim i As Long
  Dim j As Long 'Selectしなければ不要
      j = 0
      For i = 1 To ActiveSheet.Shapes.Count
          If ActiveSheet.Shapes.Item(i).TopLeftCell.Row > 10 Then
              ReDim Preserve xShapeTBL(j)             'Selectしなければ不要
              xShapeTBL(j) = i                        'Selectしなければ不要
              j = j + 1                               'Selectしなければ不要
              myColl.Add ActiveSheet.Shapes.Item(i)   '該当Shapeをコレクションに追加
          End If
      Next
      If IsArray(xShapeTBL) Then                      'Selectしなければ不要
          ActiveSheet.Shapes.Range(xShapeTBL).Select  'Selectしなければ不要
      End If                                          'Selectしなければ不要
      For Each shp In myColl                          'コレクションをループして処理
        shp.DrawingObject.Interior.ColorIndex = 3     '該当Shapeの色を赤に
      Next shp
  End Sub

 (momo)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.