リストボックスで選択した項目に対応するオートシェイプを選択する

昨日はシート上にあるオートシェイプの一覧を、ユーザーフォーム上のリストボックスに表示させてみました。

infoment.hatenablog.com

今日は、これに対応するオートシェイプの選択に挑戦です。

今日やりたいこと

リストボックスで選択した項目に対応する、オートシェイプを選択する。

必要なこと

1. IDでオートシェイプを指定
2. 選択項目に対応するオートシェイプの選択／非選択をコントロール

１．IDでオートシェイプを指定

できれば、Activesheet.Shape(ID) のような形で指定できれば良かったのですが、調べた限りでは、IDによる指定はできないようです。
そこで ID を引数として、For ～ Next を用い該当するオートシェイプを特定する関数を作成しました。

【標準モジュール】

Public Function TargetShape(ID As Long) As Shape
    Dim Shape As Shape
        For Each Shape In ActiveSheet.Shapes
            If Shape.ID = ID Then
                Set TargetShape = Shape
                Exit For
            End If
        Next        
End Function

２．オートシェイプの非選択について

オートシェイプには、

• Shape. Select
• Shppe. SelectAll

などのように、選択に関するメソッドはあります。しかし、選択解除に関するメソッドを見つけられませんでした。そこで、次の手順で選択することにします。

1. 一旦セルを選択し（今回はA1）、オートシェイプの選択を全解除
2. 次いで、オートシェイプを一つずつ選択する

具体的には、以下の通りです。

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

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

  ' ↓前回から追加した部分（２行）  
    Application.ScreenUpdating = False    
    Range("A1").Select

    Call UpdateOrder
    
' ↓ 前回から追加した部分
    Dim i As Long
    Dim j As Long
        For i = 0 To ListBox1.ListCount - 1
            If ListBox1.Selected(i) = True Then
                TargetShape(ListBox1.List(i, 1)).Select False
            End If
        Next
        
    Application.ScreenUpdating = True        
End Sub

特長として、Select の後に False を付すことで、事前のオートシェイプ選択を解除しないまま連続で選択可能となります。

結果

リストボックスで選択することで、対応するオートシェイプを選択できるようになりました。

次回に続きます。

参考まで。