【ExcelVBA】ListBoxを使ってコネクタを選択する

前回、コネクタタイプを変更できるようにしたのですが、
選択範囲内のコネクタが全て変更されてしまうので、
選択したコネクタだけを変更できるようにしたいなと考えています。

Ctrl+で選択もいいのですが、
複数あった場合、一つ一つクリックしていくのって手間が掛かります。

そこで何かいい方法がないかとネットを渡り歩いていた所、
Infomentのブログ ～Excel VBA奮闘記～　さんのブログを見つけました。

フローチャート作りをされていて、
詳しくコードを説明されているので参考にさせて頂きたいと思います。

リストボックスで選択した項目に対応するオートシェイプを選択する
有用な記事を有難うございます。
この場を借りてお礼申し上げます。m(_ _)m

早速、この記事を参考に導入してみます。
まずは、コネクタを読み込むリストボックスが必要になるので、
新しくUserFoamを追加します。

今回は、UserFoam2が空いてるので、そこに作って行きます。
必要なツールは、リストボックス・ボタン3つです。
リストボックス①.jpg
コネクタの名前を取り込むリストボックス
範囲選択した図形の中から、コネクタを取得するボタン
コネクタタイプを切り替える各ボタン2つです。

続いて、UserFoam2の管理用モジュールを作ります。
標準モジュールを追加して、UF2Controllerとリネームしておきます。
UF2Controller（標準モジュール）

Option Explicit

Dim conBoard As UserForm2

Sub ConBoardOpen()

    Set conBoard = New UserForm2
    conBoard.Show vbModeless

End Sub

シート上の操作ができないと話にならないので、
モードレスでUserFoamを呼び出します。

続いて、リストボックスにコネクタデータを取り込むのですが、
UserFoamを変数にてインスタンス化した場合、
ActiveSheet.UserFoam2.ListBox1のようなアクセスができないので、
アクセス方法を考える必要があります。

手順は二つ
・public変数でインスタンス化、他のモジュールから見えるようにする
・private変数でインスタンス化、インスタンス化したモジュール内で操作する

あまりpublic変数を使いたくないので、
UF2Controllerモジュール内でデータのやり取りができるようにしていきます。
リストボックスにデータを書きこむ際は、
UF2Controller（標準モジュール）

Sub EntryConnector()

    conBoard.ListBox1.AddItem "データ"

End Sub

登録用のプロシージャを作っておいて、
他のプロシージャから登録できるようにしておきます。

ListBoxのデータ登録が準備できたので、
実際にデータを取り込むのですが…

コネクタの名前って、英語表記で長い＆分かりにくい！(( ｰ̀ωｰ́ ).｡oஇ

リストに表示されるのは、シンプルな表示の方が良いって事で、
省略名を付ける事にします。

ただ、コネクタをコードで選択する場合、正規な名前を指定しないとエラーになるので、
リスト1：省略名
リスト2：正規名

この二つを登録できるようにします。
ListBoxには、省略名だけを表示して、正規名は見えなくしたいので、
ListBox1のプロパティから
リストボックス②.jpg
Columnを設定します。

今回、一行に二つのデータを登録するので、ColumnCountを2にします。
表示については、ColumnWidthsを設定します。

リストの表示幅をポイントで設定できます。
1つ目を50ptに設定して、コロンで区切り、2つ目を0ptにします。
Widthsを0ptにすれば、データはあるが表示部が無いって事で見えない偽装ができます。

ついでに、MultiSelectをMultiに設定します。
通常はSingleになっていて、一つしか選択できないようになっています。
Multiにする事で複数選択が可能になります。

これでListBoxの設定ができたので、リスト登録の処理を作ります。
UF2controller（標準モジュール）

Sub EntryConnector(line As Long, con As Shape)

    Dim display As String  '省略名取得変数'
    
    '省略名の設定'
    Const straight As String = "直線"
    Const elbow As String = "カギ線"
    
    Select Case con.ConnectorFormat.Type
    
        Case msoConnectorElbow
            display = elbow
            
        Case msoConnectorStraight
            display = straight

    End Select


    With conBoard.ListBox1
        .AddItem ""
        .List(line, 0) = display
        .List(line, 1) = con.Name
        
    End With
    
End Sub

引数は、リストの行とコネクタを設定します。
引数で来たコネクタのタイプから、省略名を設定してリストに登録します。

1行に複数のデータを登録する際、注意点があって、
いきなりAddItemで登録しようとしてもエラーになります。

まず、空のデータをAddItemで作っておいて、
そこに、行・列の番号指定でデータを入力する必要があります。

今回は、一列目に省略名、二列目に正式名、を登録します。

ListBoxの登録処理が作れたので、コネクタの選択処理を作ります。

標準モジュールを追加して、ConnecterChangeにリネームします。
このモジュールは、コネクタの取得とタイプの変更を処理するモジュールになります。

操作イメージとしては、
変更するコネクタ周辺を範囲選択で、図形・コネクタを一括で取得して、
コネクタだけをリストに登録する処理にします。
ConnectorChange（標準モジュール）

Option Explicit

Sub SelectionShape()

    Dim sh As Shape         '選択図形取得'
    Dim conCount As Long    'コネクタカウント数'
    
    'コネクタ判別子'
    Const conName As String = "*Connector*"
    
    conCount = 0
    
    On Error GoTo NotSelect
    
    For Each sh In Selection.ShapeRange
    
        If sh.Name Like conName Then
    
            Call EntryConnector(conCount, sh)
            conCount = conCount + 1
            
        End If

    Next
    
    Exit Sub

NotSelect:
    MsgBox "選択されてないよ！"

End Sub

選択した図形からコネクタだけを取り出したいので、
Const shapeName As String = "*Connector*"で文字を設定して、
For Each ～Next内で、Connecterの文字を含むものは、リストに登録するようにします。

変数conCountは、取得個数になります。
この個数を、リスト登録の引数lineに渡す事で順番が登録されます。
開始個数は、リストの0行目になるので、0からスタートさせます。

これで選択図形から線だけがリストUpされるはずなので、テストしてみます。
UserFoam2のコネクタ取得ボタンに、このプロシージャを割り当てて…

範囲選択で図形を一気に選択して、ボタンをPush！(｡･ω･｡)ﾉ凸”ﾎﾟﾁｯ
リストボックス⑮.jpg
上手く取得できましたヽ(´▽｀)/～♪

ListBoxに取得できたので、続ていリストをクリックすると
同じ名前の線が選択状態になるように処理を作ります。

Infomentのブログ ～Excel VBA奮闘記～さんのコードを、そのまま頂きます。(ToT)>゛スンマセン
ListBox1モジュール

Private Sub ListBox1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y As Single)

    Dim listCnt As Long

    Application.ScreenUpdating = False
    Range("A1").Select
    
    For listCnt = 0 To ListBox1.ListCount - 1
    
        With ListBox1
            
            If .Selected(listCnt) Then
                ActiveSheet.Shapes(.List(listCnt, 1)).Select False
        
            End If
                
        End With

    Next
    
    Application.ScreenUpdating = True
    
End Sub

ListBox1モジュールのコマンド、MouseUpを使います。
Clickだと選択前に呼び出されてしまうので、MouseUpで選択後に処理が走るようになってます。

リストからコネクタを選択するのですが、Multi設定になっているので、
単純に対応したコネクタを選択しても、他の選択状態を解除できません。

また、選択解除のコマンドもないので、セルClickで全解除してから、
リストで選択された図形をSelectする処理を作っておられました。

参考になります。m(_ _)m

Application.ScreenUpdatingを設定されていますが、
A1セルを選択すると、シートがA1セルが見える位置までスクロールするので、
図形選択の間、スクリーンの更新を停止してページスクロールしないようにされてます。

選択処理が終われば、スクリーンの更新をTrueに戻し忘れないように注意です。

これでリストから線が選択できるようになったのでテストします。
リストボックス④.jpg
スクショでは分かりにくいですが、無事に選択できるようになりました。

後は、線の種類を変更するだけになります。
ConnectorChange（標準モジュール）

Sub ConnectorTypeChange(connector As String)

    Dim con As Shape       '選択図形取得'
    
    '開始・終了図形の判別子'
    Const biginShape As Long = 1
    Const endShape As Long = 2
    
    On Error GoTo NotSelect
    
    For Each con In Selection.ShapeRange
    
        With con.ConnectorFormat

            Select Case connector
        
                Case "直線"
                    .Type = msoConnectorStraight
                    con.RerouteConnections
                    
                Case "カギ線"
                
                    '結合点フォーム呼び出し'
                    Call OpenForm
                    
                    .Type = msoConnectorElbow
                    .BeginConnect .BeginConnectedShape, GetBtNumber(biginShape)
                    .EndConnect .EndConnectedShape, GetBtNumber(endShape)

            End Select
            
        End With
          
    Next
    
    Exit Sub
    
NotSelect:
MsgBox "選択されてないよ！"

End Sub
線のタイプを変更する部分は、前回記事を参照下さい。
少々、無駄な部分があったので修正しています。

このプロシージャを、UserFoam2の各ボタンから呼び出します。
引数は、線タイプを設定します。

再度、選択図形を取得して線タイプを変更する処理になります。
Select caseで直線かカギ線かを判断して、それぞれの線タイプに変更する感じです。
カギ線の場合、結合点を設定するので設定用のUserFoamを呼び出しています。

ちなみにUserFoam2のボタンモジュールは、
ボタンモジュール（直線）

Private Sub CommandButton2_Click()
    
    Call ConnectorTypeChange("直線")
    
End Sub


ボタンモジュール（カギ線）

Private Sub CommandButton3_Click()
    
    Call ConnectorTypeChange("カギ線")
    
End Sub

引数を線種で設定して呼び出せばOKでっす。

完成したので、早速テストしてみます。
リストボックス⑯.jpg
4番目の図形を左に動かして、直結してる直線二つをカギ線に変更してみます。
リストボックス⑰.jpg
無事にカギ線に変更できました。

変更が終わったので、
リストの選択をクリックして解除しようとしたら…
リストボックス⑫.jpg
アイテムが見つからないとエラーが…
なんで？( -᷄ω-᷅ )💭

調べてわかったのですが、
リストボックス⑬.jpg
名前が日本語表記に書き換えられてます。

しかも、カギ線に変更したのに”直線矢印コネクタ”とか　(^.^; オホホホ

このままでは、リストのコネクタ名と本体のコネクタ名が違うので、
エラーが発生します。( ´~`).｡

名前が違わなければ問題ないので、簡単に修正します。
ConnectorChange（標準モジュール）

Sub ConnectorTypeChange(connector As String)

    Dim con As Shape       '選択図形取得'
    Dim conName As String  'コネクタ名取得'
   
    '開始・終了図形の判別子'
    Const biginShape As Long = 1
    Const endShape As Long = 2
    
    On Error GoTo NotSelect
    
    For Each con In Selection.ShapeRange
    
        conName = con.Name
    
        With con.ConnectorFormat

            Select Case connector
        
                Case "直線"
                    .Type = msoConnectorStraight
                    con.RerouteConnections
                    
                Case "カギ線"
                
                    '結合点フォーム呼び出し'
                    Call OpenForm
                    
                    .Type = msoConnectorElbow
                    .BeginConnect .BeginConnectedShape, GetBtNumber(biginShape)
                    .EndConnect .EndConnectedShape, GetBtNumber(endShape)

            End Select
            
        End With
        
        con.Name = conName
  
    Next
    
    Exit Sub
    
NotSelect:
MsgBox "選択されてないよ！"

End Sub

図形取得時に本体名を取得して、タイプ変更後に再設定すればOK！

テストしてみた所、問題なくなりました。ヽ(´▽｀)/～♪

これでCtrl+で選択しなくても選択できて、個別・一括のタイプ変更ができるので、
作業がしやすくなりそうです。

しかし、操作的には問題ないんですが、リスト表示が変更されないんですよね。
リストの省略名も変更しないと気持ち悪いので、変更処理を考える必要があります。

また、範囲選択してコネクタを取得したのですが、
図形も同じ処理が使えそうなので、
同時に図形と線を両方取得して、ListBoxでコントロールする方法も考えてみようかと。

この辺りが作れたら、次回にまとめようと思います。
それまでは( ^ 0 ^ )/~~~~see you again




この記事へのコメント

コメントを書く

この記事へのトラックバック