エクセルのワークシート上にVBAで作ったオートシェイプを、引き続きVBAでグループ化したいと考えています。これらのオートシェイプは番号・名前は自動的に付けられ不定です。


基本的なところで、このような複数のオートシェイプを順番にひとまとめに選択していく方法がわかりません。選択方法がわかれば、
Selection.ShapeRange.Group.Select
でグループ化できると思いますので、選択するコードの書き方を教えてください。

回答の条件
  • 1人2回まで
  • 登録:2007/03/24 00:47:11
  • 終了:2007/03/24 12:08:11

回答(3件)

id:llusall No.1

llusall回答回数505ベストアンサー獲得回数612007/03/24 10:13:55

ポイント50pt

>オートシェイプを順番にひとまとめ

とは、「作成した順に」ということで良いですか?


以下、サンプルです。

IDを見て作成順を判断しました。

Option Explicit

Private Type ShapesInfo

    shapeCount As Integer       'シェイプの数

    firstShapeName As String    '最初のシェイプの名前

    secondShapeName As String   '2番目のシェイプの名前

    lastShapeName As String     '最後のシェイプの名前

End Type


Private Sub Test()

    Dim info As ShapesInfo

    'シェイプの情報を取得

    info = GetShapesInfo()

    If info.shapeCount = 0 Then

        MsgBox "オートシェイプなし"

        Exit Sub

    End If

    If info.shapeCount = 1 Then

        MsgBox "1しかないのでNG"

        Exit Sub

    End If

    

    '1回目グループ化。最初+2番目

    ActiveSheet.Shapes.Range(Array(info.firstShapeName, info.secondShapeName)).Select

    Selection.ShapeRange.Group

 

    Do

        'シェイプの情報を取得

        info = GetShapesInfo()

        If info.shapeCount <= 1 Then

            Exit Do

        End If

        'n回目グループ化。最後+最初

        ActiveSheet.Shapes.Range(Array(info.lastShapeName, info.firstShapeName)).Select

        Selection.ShapeRange.Group

    Loop

    MsgBox "おしまい"

End Sub

Private Function GetShapesInfo() As ShapesInfo

    Dim firstShapeId As Integer

    Dim firstShapeName As String

    Dim secondShapeId As Integer

    Dim secondShapeName As String

    Dim lastShapeId As Integer

    Dim lastShapeName As String

    

    Dim sp As Shape

    '初期化

    firstShapeId = 32767

    firstShapeName = ""

    secondShapeId = 32767

    secondShapeName = ""

    lastShapeId = 0

    lastShapeName = ""

    'すべてのシェイプを調べる

    For Each sp In ActiveSheet.Shapes

        If firstShapeId > sp.ID Then

            '2番目のシェイプ

            secondShapeId = firstShapeId

            secondShapeName = firstShapeName

            '最初のシェイプ

            firstShapeId = sp.ID

            firstShapeName = sp.Name

        End If

        If secondShapeId > sp.ID And firstShapeId < sp.ID Then

            '2番目のシェイプ

            secondShapeId = sp.ID

            secondShapeName = sp.Name

        End If

        If lastShapeId < sp.ID Then

            '最後のシェイプ

            lastShapeId = sp.ID

            lastShapeName = sp.Name

        End If

    Next

    

    Dim info As ShapesInfo

    info.shapeCount = ActiveSheet.Shapes.Count

    info.firstShapeName = firstShapeName

    info.secondShapeName = secondShapeName

    info.lastShapeName = lastShapeName

    GetShapesInfo = info

    

End Function

※グループ化にグループ化を重ねて行くのですが、数に制限があるかもしれません。

id:mouitchou

立派なコードをありがとうございます。さっそく一部抜粋利用させていただき、シェイプを作った都度グループ化するようにしましたところ、うまく動作しました。助かりました。

2007/03/24 12:02:15
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692007/03/24 10:54:13

ポイント25pt

一瞬遅かったけどこんな感じ

Sub Macro()
    Dim ob As Shape
    Dim st() As Variant
    Dim i As Integer
    i = 0
    For Each ob In ActiveSheet.Shapes
        ReDim Preserve st(i)
        st(i) = ob.Name
        i = i + 1
    Next ob
    ActiveSheet.Shapes.Range(st).Select
    Selection.ShapeRange.Group.Select
End Sub
id:mouitchou

。ありがとうございます。

st(i) = ob.Name と

ActiveSheet.Shapes.Range(st).Select

がキモなのですね。以後使わせていただきます

2007/03/24 12:02:37
id:llusall No.3

llusall回答回数505ベストアンサー獲得回数612007/03/24 10:57:26

ポイント20pt

再回答ですみません。

すべてのオートシェイプを1つのグループにするのでしたら

こちらでいけると思います。

    Dim sp As Shape

    Dim aryName()

    Dim cnt As Integer

    cnt = -1

    For Each sp In ActiveSheet.Shapes

        cnt = cnt + 1

        ReDim Preserve aryName(cnt)

        aryName(cnt) = sp.Name

    Next

    If cnt = -1 Then

        MsgBox "オートシェイプなし"

        Exit Sub

    End If

    ActiveSheet.Shapes.Range(aryName).Select

    Selection.ShapeRange.Group.Select

id:mouitchou

再度のご回答有り難うございます。

順番に作る都度グループ化することにしたので、

For Eachループを必要とはしませんでしたが、今後の参考にさせていただきます。

2007/03/24 12:05:21

コメントはまだありません

この質問への反応(ブックマークコメント)

トラックバック

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません