VB 2010 によるエクセルの操作 図(図形)のグループ化、グループの解除の方法

Question

タイトルについてご教示をお願い致します。

VBAであれば次のとおりで問題ないのですが、VB.NET 2010ではどの様にすれば宜しいのでしょうか。

どうぞよろしくお願い致します。

For Each shp In ActiveSheet.Shapes
        If shp.Type = msoGroup Then
            bGrp= True
            shp.Ungroup 'グループ解除
        End If
 Next shp 

Answer 1

Excel 2013 & VB.NET 2010 で試しました。

Imports Microsoft.Office.Core
Imports Microsoft.Office.Interop

Public Class Form1
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Dim app As Excel.Application
        Dim book As Excel.Workbook
        Dim sheet As Excel.Worksheet

        app = CreateObject("Excel.Application")
        app.Visible = False

        book = app.Workbooks.Open("C:\work\Book1.xlsx")

        sheet = book.Worksheets(1)

        For Each shp In sheet.Shapes
            If shp.Type = MsoShapeType.msoGroup Then
                shp.Ungroup() 'グループ解除
            End If
        Next shp

        book.SaveAs("C:\work\Book2.xlsx")

        app.Quit()

        sheet = Nothing
        book = Nothing
        app = Nothing
    End Sub
End Class

ほぼ同じようなコードで行けました。

Answer 2

完全分解とグループ化も含めて書いてみる

Imports Microsoft.Office.Interop.Excel
Module Module1

    Sub Main()
        Dim xla As Microsoft.Office.Interop.Excel.Application
        Dim xlbs As Workbooks
        Dim xlb As Workbook

        xla = New Microsoft.Office.Interop.Excel.Application()
        xla.Visible = True

        xlbs = xla.Workbooks
        xlb = xlbs.Open("D:\Book1.xlsx")

        'ActiveSheetはWorkSheetではない場合がある
        If (TypeOf xlb.ActiveSheet Is Microsoft.Office.Interop.Excel.Chart) Then
            MsgBox("ActiveSheetはグラフになっています")

        ElseIf (TypeOf xlb.ActiveSheet Is Worksheet) Then

            Dim xlws As Worksheet
            xlws = xlb.ActiveSheet

            '分解
            Dim shp As Shape
            For Each shp In xlws.Shapes

                If True Then
                    'グルーブの子要素をさらに分解する場合
                    UngroupAll(shp)
                Else '最上位のグループのみ分解する場合
                    shp.Ungroup()
                End If
            Next


            'グループ化()
            Dim shapeNames As New List(Of Object)
            Dim shapes As Microsoft.Office.Interop.Excel.ShapeRange
            For i As Integer = 1 To xlws.Shapes.Count Step 2 'ためしに1個おきにグループ化してみる

                shp = xlws.Shapes.Item(i)
                shapeNames.Add(shp.Name)
            Next

            Dim o As Object() = shapeNames.ToArray() 'Listのままでは渡せないので配列に変換
            shapes = xlws.Shapes.Range(o)
            shapes.Group()
        End If
    End Sub

    ''' <summary>グループ化されているShapeを完全分解する</summary>
    Public Sub UngroupAll(ByVal shp As Microsoft.Office.Interop.Excel.Shape)

        If (shp.Type = Microsoft.Office.Core.MsoShapeType.msoGroup) Then
            Dim allShapes As New List(Of Shape)
            Dim newShapes = New List(Of Shape)
            '分解前に存在するすべてのShapeを取得
            For Each shpChild As Shape In CType(shp.Parent, Worksheet).Shapes
                If (shpChild.Name <> shp.Name) Then
                    allShapes.Add(shpChild)
                End If
            Next

            shp.Ungroup()

            '分解後に存在するすべてのShapeを取得
            For Each shpChild As Shape In CType(shp.Parent, Worksheet).Shapes
                newShapes.Add(shpChild)
            Next

            '差を見て分解して出てきたShapeを取り出す
            newShapes = newShapes.Except(allShapes).ToList()

            'さらに分解
            For Each shpChild In newShapes
                UngroupAll(shpChild)
            Next
        End If
    End Sub
End Module

---

個別に明示されていない限りgekkaがフォーラムに投稿したコードにはフォーラム使用条件に基づき「MICROSOFT LIMITED PUBLIC LICENSE」が適用されます。(かなり自由に使ってOK!)

Answer 3

ご回答ありがとうございました。

エクセルのバージョンに依存しないアプリの開発しております。

参照の追加をしない手法で、お願い致します。

最初に書いておけば良かったのですが、申し訳ございません。

Public Class Form1
    Public Shared xlApp As Object, xlBook As Object, xlSheet As Object

    Private Sub Form1_Load(sender As System.Object, e As System.EventArgs) Handles MyBase.Load
        Dim MsoShapeType

        xlApp = GetObject(, "Excel.Application")
        xlBook = xlApp.activeworkbook
        xlSheet = xlBook.ActiveSheet

        For Each shp In xlSheet.Shapes
            If shp.Type = MsoShapeType.msoGroup Then　　←　ここでエラーがでます。
                shp.Ungroup()
            End If
        Next shp

    End Sub
End Class

Answer 4

ご返信ありがとうございました。

私には簡単に解析できそうもありませんが。じっくり解析して、活用したいと思います。

Answer 5

https://msdn.microsoft.com/ja-jp/library/office/ff860759.aspx

MsoShapeType.msoGroup は数値の 6 で定義されていますので、

For Each shp In sheet.Shapes
    If shp.Type = 6 Then 'Microsoft.Office.Core.MsoShapeType.msoGroup
        shp.Ungroup() 'グループ解除
    End If
Next shp

の様に記述すると動くかと思います。

Answer 6

動作致しました。

ありがとうございました。