選択したオートシェイプを変更する - Infomentのブログ～Excel VBA奮闘記～

昨日はリストボックスに表示されたオートシェイプ一覧を用いて、任意のオートシェイプを選択してみました。
infoment.hatenablog.com

今日は、任意に選択したオートシェイプの形状の変更に挑戦です。

今日やりたいこと
必要なこと
結果

今日やりたいこと

今回の相談者からは、とりあえず以下３つの形状を要望されていました。

接点
処理
分岐

そこで任意選択したオートシェイプについて、以下手順による変更を試みました。

任意のオートシェイプ選択
コンボボックス内から、変更後の形状を選択
選択済みオートシェイプを全て、指定した形状に変更

必要なこと

変更方法の確認
ユーザーフォームにコンボボックスを配置
コンボボックスのチェンジイベントを設定

１．変更方法の確認

選択済みオートシェイプの形状は、以下の方法で変更できるようです。

Selection.ShapeRange.AutoShapeType = ？

？の部分には、希望する形状のパラメータを指定します。

接点：msoShapeFlowchartTerminator
処理：msoShapeFlowchartProcess
分岐：msoShapeFlowchartDecision

２．コンボボックスの配置

今までのユーザーフォームに、コンボボックスを配置します。ところで使用者は、「msoShapeFlowchartTerminator」なんて長いパラメータを知っておく必要はありません。そこで表示は「接点」などの日本語とし、対応するパラメータを取得するようにします。

【コンボボックスの仕様】

表示する列　⇒　１列目
値の取得列　⇒　２列目

【ユーザーフォームのモジュール】

Private Sub UserForm_Initialize()
    Dim Shape As Shape
    Dim ListBoxSeq As Variant
    ReDim ListBoxSeq(1 To ActiveSheet.Shapes.Count, 1 To 3)
    Dim i As Long
        i = 1
        For Each Shape In ActiveSheet.Shapes
            If Not Shape.Name Like "*Connector*" Then
                ListBoxSeq(i, 1) = Shape.TextFrame2.TextRange.Characters.Text
                ListBoxSeq(i, 2) = Shape.ID
                ListBoxSeq(i, 3) = 0
                i = i + 1
            End If
        Next
        ListBox1.List = ListBoxSeq

' ↓ 今回追加した箇所
' コンボボックス用の配列を作成
    Dim ComboBoxSeq(1 To 3, 1 To 2)
        ComboBoxSeq(1, 1) = "接点": ComboBoxSeq(1, 2) = msoShapeFlowchartTerminator
        ComboBoxSeq(2, 1) = "処理": ComboBoxSeq(2, 2) = msoShapeFlowchartProcess
        ComboBoxSeq(3, 1) = "分岐": ComboBoxSeq(3, 2) = msoShapeFlowchartDecision

' コンボボックスに上記配列をセット
        With ComboBox1
            .ColumnCount = 2
            .TextColumn = 1
            .BoundColumn = 2
            .List = ComboBoxSeq
        End With
                    
End Sub

これで、コンボボックスから３つの形状を選択できるようになりました。
f:id:Infoment:20180915073502p:plain

３．オートシェイプの形状変更

コンボボックスのチェンジイベントで、選択済みのオートシェイプについて形状を一括変更します。

【ユーザーフォームのモジュール】

Private Sub ComboBox1_Change()
    On Error GoTo er:
    If ComboBox1.Value <> "" Then
        Selection.ShapeRange.AutoShapeType = ComboBox1.Value
    End If    
    Exit Sub
er:
    If Err.Number = 438 Then
        MsgBox "オートシェイプを選択したうえで、再度実施してください。"
    End If    
End Sub