【Excel VBA】직사각형 Shape끼리의 포함 관계를 문장으로 출력한다

개요



Excel에서 액티브 시트 상에 있는 구형 텍스트 박스의 포함 관계를 「X는 A와 B와 C를 가진다.」등의 문장으로 해 출력한다.

계기/용도



컴퓨터 소프트웨어 관계의 특허를 출원할 때, 「컴퓨터(100)는 기억부(110) 및 계산부(120)를 가진다. 그래서 두 번 번거로운 방지 + 실수 방지를 위해 도면에서 문장을 생성하고 싶었습니다. 1

처리



포함 관계



나는 수학에 대해 잘 모르겠지만, 우선 Wikipedia의 "부분 집합"의 정의에 따라 한 도형에 다른 도형이 모두 포함되어 있는지 여부를 판단하기로합시다.
htps : // 그럼.ぃきぺぢ아. rg/우우키/%에9%83%에8%에5%88%86%에9%9B%86%에5%90%88

동일한 축에 있는 두 선의 최소값과 최대값을 넣으면 전자가 후자를 포함하는지 여부를 결정하는 함수를 만듭니다.
직사각형끼리라면 이것을 X 좌표와 Y 좌표로 2회 판정하면 됩니다.
Private Function AIncludesB(Amin, Amax, Bmin, Bmax) As Boolean
    AIncludesB = False
    If (Amin <= Bmin) And (Amax >= Bmax) Then
        AIncludesB = True
    End If
End Function

도형끼리의 포함관계를 취득



도형 관계의 포함 관계를 가져와 2차원 배열에 저장합니다. 2
도형 i가 도형 j를 포함할 때 arrShps(i,j) = Ture로 합시다.
이 때 i를 부모 Shape, j를 자식 Shape라고도합니다.

단, 예를 들면 i>j>k 관계가 되고 있다고 해서 기재하는 것은 직접의 부모-자식 관계에 있는 i>j, j>k의 관계만입니다.
그래서 i가 j를 포함한다고해서 손자 Shape의 k는 제외합니다.

Sub ShpInclude()
    Dim i As Long, j As Long, k As Long

    Dim ShapesCnt
    ShapesCnt = ActiveSheet.Shapes.Count  'ここ代入しないとなぜかエラーになる
    Dim arrShps()
    ReDim Preserve arrShps(1 To ShapesCnt, 1 To ShapesCnt)

    Dim hasChild As Variant
    Dim strOutput As String

    With ActiveSheet

        For i = 1 To ShapesCnt
            For j = 1 To ShapesCnt
                If i <> j Then
                    If AIncludesB(.Shapes(i).Left, .Shapes(i).Left + .Shapes(i).Width, .Shapes(j).Left, .Shapes(j).Left + .Shapes(j).Width) And AIncludesB(.Shapes(i).Top, .Shapes(i).Top + .Shapes(i).Height, .Shapes(j).Top, .Shapes(j).Top + .Shapes(j).Height) Then
                        Debug.Print (.Shapes(i).TextFrame2.TextRange.Text & "⊇" & .Shapes(j).TextFrame2.TextRange.Text)
                        'Shapeが子Shapeを持っているか定義する
                        arrShps(i, j) = True
                    End If
                End If
            Next
        Next

        '子Shapeにさらに子Shape(孫Shape=k)がいる場合、その孫Shapeを除外
        For i = 1 To ShapesCnt
            hasChild = 0
            strOutput = ""
            For j = 1 To ShapesCnt
                If arrShps(i, j) Then
                    hasChild = hasChild + 1
                    For k = 1 To ShapesCnt
                        If arrShps(j, k) And arrShps(i, k) Then
                            arrShps(i, k) = False
                        End If
                    Next
                End If
            Next

            '「XはAとBとCからなり、Aはaからなる」等の文章を出力
            'ここでは「XはAとBとCを有する」等を出力
            If hasChild Then
                strOutput = .Shapes(i).TextFrame2.TextRange.Text & "は、"
                For j = 1 To ShapesCnt
                    If arrShps(i, j) Then
                        strOutput = strOutput & .Shapes(j).TextFrame2.TextRange.Text & "と、"
                    End If
                Next
                strOutput = strOutput & "を有する。"
            End If
            Range("A" & i + 1).Value = strOutput
        Next
    End With

End Sub

실행 예 및 결과



오른쪽 그림에서 왼쪽 문장을 일단 할 수있었습니다.
조금 수정 3 하지만 필요합니다만, 아무튼 아닐까요.




창작 물건의 설정서/기획서로부터 조직 등 문장에 일으키는 것에도 응용할 수 있을 것 같다. 「A국에는 B와 C와 D의 지역이 있다」라고.

VBA에서 노드를 처리할 수 있는 것으로 TreeView 컨트롤이라는 것이 있는 것 같습니다만, 아직 시도하지 않았습니다.

차례라든가, 아이 Shape가 1개만일 때의 처리라든지. 인출선·부호라든지의 처리는 귀찮기 때문에 나중에 어떻게든 합니다…… 

좋은 웹페이지 즐겨찾기