メインコンテンツへスキップ

Excelで複数のチェックボックスを含むドロップダウンリストを作成するにはどうすればよいですか?

多くのExcelユーザーは、時間ごとにリストから複数のアイテムを選択するために、複数のチェックボックスを備えたドロップダウンリストを作成する傾向があります。 実際には、データ検証を使用して複数のチェックボックスを含むリストを作成することはできません。 このチュートリアルでは、Excelで複数のチェックボックスを備えたドロップダウンリストを作成するXNUMXつの方法を紹介します。

リストボックスを使用して、複数のチェックボックスを含むドロップダウンリストを作成します
A:ソースデータを含むリストボックスを作成します
B:選択したアイテムを配置するセルに名前を付けます
C:選択したアイテムの出力に役立つ図形を挿入します
すばらしいツールを使用して、チェックボックス付きのドロップダウンリストを簡単に作成できます
ドロップダウンリストのその他のチュートリアル...


リストボックスを使用して、複数のチェックボックスを含むドロップダウンリストを作成します

以下のスクリーンショットに示すように、現在のワークシートでは、範囲A2:A11のすべての名前がリストボックスのソースデータになります。 セルC4のボタンをクリックすると、選択したアイテムが出力され、リストボックスで選択したすべてのアイテムがセルE4に表示されます。 これを実現するには、次のようにしてください。

A.ソースデータを含むリストボックスを作成します

1。 クリック Developer > インセット > リストボックス(Active Xコントロール)。 スクリーンショットを参照してください:

2.現在のワークシートにリストボックスを描画し、右クリックして選択します プロパティ 右クリックメニューから。

3。 の中に プロパティ ダイアログボックスでは、次のように構成する必要があります。

  • 3.1で リストフィル範囲 ボックスに、リストに表示するソース範囲を入力します(ここに範囲を入力します) A2:A11);
  • 3.2で リストスタイル ボックス、選択 1-fmList StyleOption;
  • 3.3で 複数選択 ボックス、選択 1 – fmMultiSelectMulti;
  • 3.4閉じる プロパティ ダイアログボックス。 スクリーンショットを参照してください:

B:選択したアイテムを配置するセルに名前を付けます

選択したすべての項目をE4などの指定したセルに出力する必要がある場合は、次のようにしてください。

1.セルE4を選択し、次のように入力します リストボックス出力名前ボックス を押して 入力します キー。

C.選択したアイテムの出力に役立つ図形を挿入します

1。 クリック インセット > 形状 > 矩形。 スクリーンショットを参照してください:

2.ワークシートに長方形を描画します(ここでは、セルC4に長方形を描画します)。 次に、長方形を右クリックして、 マクロの割り当て 右クリックメニューから。

3。 の中に マクロの割り当て ダイアログボックスで NEW

4.オープニングで アプリケーション向け Microsoft Visual Basic ウィンドウで、元のコードを置き換えてください モジュール 以下のVBAコードのウィンドウ。

VBAコード:複数のチェックボックスを含むリストを作成します

Sub Rectangle1_Click()
'Updated by Extendoffice 20200730
Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String
Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = ActiveSheet.ListBox1
If xLstBox.Visible = False Then
    xLstBox.Visible = True
    xSelShp.TextFrame2.TextRange.Characters.Text = "Pickup Options"
    xStr = ""
    xStr = Range("ListBoxOutput").Value
    
    If xStr <> "" Then
         xArr = Split(xStr, ";")
    For I = xLstBox.ListCount - 1 To 0 Step -1
        xV = xLstBox.List(I)
        For J = 0 To UBound(xArr)
            If xArr(J) = xV Then
              xLstBox.Selected(I) = True
              Exit For
            End If
        Next
    Next I
    End If
Else
    xLstBox.Visible = False
    xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
    For I = xLstBox.ListCount - 1 To 0 Step -1
        If xLstBox.Selected(I) = True Then
        xSelLst = xLstBox.List(I) & ";" & xSelLst
        End If
    Next I
    If xSelLst <> "" Then
        Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 1)
    Else
        Range("ListBoxOutput") = ""
    End If
End If
End Sub

注: コードでは、 長方形1 形状名です。 ListBox1 リストボックスの名前です。 商品詳細 > ピックアップオプション 図形の表示テキストです。 そしてその リストボックス出力 出力セルの範囲名です。 必要に応じて変更できます。

5。 押す 他の + Q キーを同時に閉じて アプリケーション向け Microsoft Visual Basic 窓。

6.長方形のボタンをクリックすると、リストボックスが折りたたまれたり展開されたりします。 リストボックスが展開しているときに、リストボックスの項目をチェックしてから、長方形をもう一度クリックして、選択したすべての項目をセルE4に出力します。 以下のデモを参照してください。

7.次に、ブックをとして保存します。 ExcelMacroEnableワークブック 将来的にコードを再利用するため。


素晴らしいツールでチェックボックス付きのドロップダウンリストを作成する

上記の方法は多段階であり、簡単に処理できません。 ここで強くお勧めします チェックボックス付きのドロップダウンリスト の有用性 クツール Excel 指定した範囲のチェックボックス、現在のワークシート、現在のワークブック、または必要に応じて開いているすべてのワークブックを含むドロップダウンリストを簡単に作成できるようにします。 以下のデモを参照してください。
今すぐダウンロードして試してください! (30日間の無料トレイル)

上記のデモに加えて、この機能を適用してこのタスクを実行する方法を示すステップバイステップガイドも提供します。 次のようにしてください。

1.データ検証ドロップダウンリストを設定したワークシートを開き、をクリックします クツール > ドロップダウンリスト > チェックボックス付きのドロップダウンリスト > 設定を行います。 スクリーンショットを参照してください:

2。 の中に チェックボックス設定付きのドロップダウンリスト ダイアログボックスで、次のように構成してください。

  • 2.1) 適用する セクションで、ドロップダウンリストの項目のチェックボックスを作成する適用範囲を指定します。 指定できます 特定の範囲, 現在のワークシート, 現在のワークブック or 開いているすべてのブック あなたのニーズに基づいて。
  • 2.2) モード セクションで、選択したアイテムを出力するスタイルを選択します。
  • ここで取る 修正します 例としてオプションを選択すると、これを選択すると、選択した項目に基づいてセルの値が変更されます。
  • 2.3) セパレータ ボックスに、複数のアイテムを区切るために使用する区切り文字を入力します。
  • 2.4) テキストの方向 セクションでは、ニーズに基づいてテキストの方向を選択します。
  • 2.5)をクリックします OK

3.最後のステップで、をクリックします クツール > ドロップダウンリスト > チェックボックス付きのドロップダウンリスト > チェックボックスのドロップダウンリストを有効にする この機能をアクティブにします。

今後、指定したスコープ内のドロップダウンリストのあるセルをクリックすると、リストボックスがポップアップします。チェックボックスをオンにして項目を選択し、以下のデモのようにセルに出力してください(例として変更モードを取り上げます)。 )。

この機能の詳細については、 こちらをご覧ください.

  このユーティリティの無料トライアル(30日)が必要な場合は、 クリックしてダウンロードしてください、次に、上記の手順に従って操作を適用します。


関連記事:

Excelのドロップダウンリストに入力するとオートコンプリート
大きな値を持つデータ検証ドロップダウンリストがある場合は、適切なものを見つけるためだけにリストを下にスクロールするか、リストボックスに単語全体を直接入力する必要があります。 ドロップダウンリストの最初の文字を入力するときにオートコンプリートを許可する方法があれば、すべてが簡単になります。 このチュートリアルでは、問題を解決する方法を説明します。

Excelで別のブックからドロップダウンリストを作成する
ブック内のワークシート間でデータ検証ドロップダウンリストを作成するのは非常に簡単です。 しかし、データ検証に必要なリストデータが別のブックにある場合は、どうしますか? このチュートリアルでは、Excelの別のブックからドロップファウンリストを作成する方法について詳しく学習します。

Excelで検索可能なドロップダウンリストを作成する
多数の値を持つドロップダウンリストの場合、適切な値を見つけるのは簡単な作業ではありません。 以前、ドロップダウンボックスに最初の文字を入力したときにドロップダウンリストをオートコンプリートする方法を導入しました。 オートコンプリート機能に加えて、ドロップダウンリストを検索可能にして、ドロップダウンリストで適切な値を見つける作業効率を高めることもできます。 ドロップダウンリストを検索可能にするには、このチュートリアルの方法を試してください。

Excelのドロップダウンリストで値を選択すると、他のセルに自動入力されます
セル範囲B8:B14の値に基づいてドロップダウンリストを作成したとします。 ドロップダウンリストで任意の値を選択する場合、セル範囲C8:C14の対応する値が選択したセルに自動的に入力されるようにします。 問題を解決するために、このチュートリアルの方法はあなたに有利になります。

ドロップダウンリストのその他のチュートリアル...

最高のオフィス生産性向上ツール

人気の機能: 重複を検索、強調表示、または識別する   |  空白行を削除する   |  データを失わずに列またはセルを結合する   |   数式なしのラウンド ...
スーパールックアップ: 複数の基準の VLookup    複数の値の VLookup  |   複数のシートにわたる VLookup   |   ファジールックアップ ....
詳細ドロップダウン リスト: ドロップダウンリストを素早く作成する   |  依存関係のドロップダウン リスト   |  複数選択のドロップダウンリスト ....
列マネージャー: 特定の数の列を追加する  |  列の移動  |  Toggle 非表示列の表示ステータス  |  範囲と列の比較 ...
注目の機能: グリッドフォーカス   |  デザインビュー   |   ビッグフォーミュラバー    ワークブックとシートマネージャー   |  リソースライブラリ (自動テキスト)   |  日付ピッカー   |  ワークシートを組み合わせる   |  セルの暗号化/復号化    リストごとにメールを送信する   |  スーパーフィルター   |   特殊フィルター (太字/斜体/取り消し線をフィルター...) ...
上位 15 のツールセット12 テキスト 工具 (テキストを追加, 文字を削除する、...)   |   50+ チャート 種類 (ガントチャート、...)   |   40+ 実用的 (誕生日に基づいて年齢を計算する、...)   |   19 挿入 工具 (QRコードを挿入, パスから画像を挿入、...)   |   12 変換 工具 (数字から言葉へ, 通貨の換算、...)   |   7 マージ&スプリット 工具 (高度な結合行, 分割セル、...)   |   ... もっと

Kutools for Excel で Excel スキルを強化し、これまでにない効率を体験してください。 Kutools for Excelは、生産性を向上させ、時間を節約するための300以上の高度な機能を提供します。  最も必要な機能を入手するにはここをクリックしてください...

kteタブ201905


Officeタブは、タブ付きのインターフェイスをOfficeにもたらし、作​​業をはるかに簡単にします

  • Word、Excel、PowerPointでタブ付きの編集と読み取りを有効にする、パブリッシャー、アクセス、Visioおよびプロジェクト。
  • 新しいウィンドウではなく、同じウィンドウの新しいタブで複数のドキュメントを開いて作成します。
  • 生産性を 50% 向上させ、毎日何百回もマウス クリックを減らすことができます!
Comments (70)
No ratings yet. Be the first to rate!
This comment was minimized by the moderator on the site
Hello-

This is fabulous, but I was wondering if there is a way to call the code as a subroutine, ie Click Button 1, run this code with X List Box and X Output cell. I want to pass the listbox and the output cell as variables into this code. Any help would be greatly appreciated.

I've tried this:
Private Sub Rectangle1_Click()
Call MultiSelctDropdown(ListBox1,Output1)
End Sub

Private Sub Rectangle2_Click()
Call MultiSelctDropdown(ListBox2,Output2)
End Sub

Private Sub MultiSelectDropdown(ListBox As String, Output As String)
Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String
Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = ActiveSheet.ListBox
If xLstBox.Visible = False Then
xLstBox.Visible = True
xSelShp.TextFrame2.TextRange.Characters.Text = "Enter"
xStr = ""
xStr = Range("Output").Value

If xStr <> "" Then
xArr = Split(xStr, ",")
For I = xLstBox.ListCount - 1 To 0 Step -1
xV = xLstBox.List(I)
For J = 0 To UBound(xArr)
If xArr(J) = xV Then
xLstBox.Selected(I) = True
Exit For
End If
Next
Next I
End If
Else
xLstBox.Visible = False
xSelShp.TextFrame2.TextRange.Characters.Text = "Click Here to Select Products"
For I = xLstBox.ListCount - 1 To 0 Step -1
If xLstBox.Selected(I) = True Then
xSelLst = xLstBox.List(I) & "," & xSelLst
End If
Next I
If xSelLst <> "" Then
Range("Output") = Mid(xSelLst, 1, Len(xSelLst) - 1)
Else
Range("Output") = ""
End If
End If
End Sub
This comment was minimized by the moderator on the site
Ok I figured this one out (see below)

But now I want to have only ONE list box that I can use over and over again with different buttons but different output depending on the button pushed. And the code below works for this EXCEPT the items selected when the list box pops up includes all items that have been outputted from the code.

If list box1 contains

Apples
Oranges
Pears
Kiwi

and button 1 is pressed and Apples is selected, when button 2 is pressed Apples is already selected, and if during button press 2 pears is selected when you go back to button 1 Apples AND Pears are selected.

How can I either clear all selected when a button is pressed OR make the selected options equal to the output.


Private Sub Button1_Click()
Call ProductSelection(ActiveSheet.ListBox1, "Button1Output", 243, 215)
End Sub
Private Sub Button2_Click()
Call ProductSelection(ActiveSheet.ListBox1, "Button2Output", 472, 215)
End Sub



Private Sub ProductSelection(xListBox As Object, Output As String, left As Integer, height As Integer)
Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String
Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = xListBox
If xLstBox.Visible = False Then
xLstBox.Visible = True
xLstBox.left = left
xLstBox.height = height
xSelShp.TextFrame2.TextRange.Characters.Text = "Enter"
xStr = ""
xStr = Range(Output).Value

If xStr <> "" Then
xArr = Split(xStr, ",")
For I = xLstBox.ListCount - 1 To 0 Step -1
xV = xLstBox.List(I)
For J = 0 To UBound(xArr)
If xArr(J) = xV Then
xLstBox.Selected(I) = True
Exit For
End If
Next
Next I
End If
Else
xLstBox.Visible = False
xSelShp.TextFrame2.TextRange.Characters.Text = "Click Here to Select Products"
For I = xLstBox.ListCount - 1 To 0 Step -1
If xLstBox.Selected(I) = True Then
xSelLst = xLstBox.List(I) & "," & xSelLst
End If
Next I
If xSelLst <> "" Then
Range(Output) = Mid(xSelLst, 1, Len(xSelLst) - 1)
Else
Range(Output) = ""
End If
End If
End Sub
This comment was minimized by the moderator on the site
Hi there- this is super helpful, thank you! Can you tell me how I can draw a list box based on a list in a different worksheet (but same file)? I've tried entering my worksheet name (i.e., 'lists') followed by the range in the list fill range (after clicking on Properties) but this does not work.Thanks!
This comment was minimized by the moderator on the site
Hi Meghan,Supposing you want to <span style="letter-spacing: 0.2px; color: inherit; font-family: inherit; font-style: inherit; font-variant-ligatures: inherit; font-variant-caps: inherit;">ListBox1</span><span style="letter-spacing: 0.2px; color: inherit; font-family: inherit; font-style: inherit; font-variant-ligatures: inherit; font-variant-caps: inherit;">Sheet1</span><div data-tag="code">Sub listboxlistfillrangefromdifferentsheet()
Sheet1.ListBox1.ListFillRange = Sheet2.Range("A2:A20").Address(, , , True)
End Sub
This comment was minimized by the moderator on the site
hello, I have a problem with the list box: to make the list going down, I have to click on the box that allows the list to go down but when I click, it does not go down automatically, I have to click outside the list so that it refreshes and the list goes down, what to do? Thank you
This comment was minimized by the moderator on the site
Hi,You can't scroll ActiveX Listbox by mouse wheel. There is no setting for it.

This comment was minimized by the moderator on the site
Hi, thank you for sharing this! I have a question though, is it possible to populate different cells based on the selected option?For example, instead of having everything in one cell, each selection is populated in the cell below the earlier selection. Thank you!
This comment was minimized by the moderator on the site
Hi faez,
The VBA below helps to populate the selected options in different cells on the same row. Please have a try.

Sub Rectangle2_Click()
'Updated by Extendoffice 20211124
Dim xSelShp As Shape, xSelLst As Variant, I As Integer
Dim xRg As Range
Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = ActiveSheet.ListBox1
If xLstBox.Visible = False Then
xLstBox.Visible = True
xSelShp.TextFrame2.TextRange.Characters.Text = "Pickup Options"
Else
xLstBox.Visible = False
xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
Set xRg = Range("ListBoxOutput")
For I = 0 To xLstBox.ListCount - 1
If xLstBox.Selected(I) = True Then
xSelLst = xLstBox.List(I)
xRg.Value = Mid(xSelLst, 1, Len(xSelLst))
Set xRg = xRg.Offset(0, 1)
End If
Next I
End If
End Sub
This comment was minimized by the moderator on the site
Hi Crystal,
Thanks a lot for this code, very helpful and convenient. One question : how to adpat it in order not to have the separator ";" if only one item is selected ?
This comment was minimized by the moderator on the site
Hi Eloi,No separator is displayed when you select only one item in the list.
This comment was minimized by the moderator on the site
Thanks Crystal, the mistake was in my adaptation of the code.
If someone needs to adapt it with a click on a cell instead of a click on a shape, you could try this (with a call to this sub in your sheet, with a condition when your cell is selected)

Sub affichage_liste(xLstBox As MSForms.ListBox, texte1 As String)
'Updated by Extendoffice 20200730
Dim xSelLst As Variant, I, J As Integer
Dim xV As String

If xLstBox.Visible = False Then
xLstBox.Visible = True
xStr = ""
xStr = Range(texte1).Value

If xStr <> "" Then
xArr = Split(xStr, ";")
For I = xLstBox.ListCount - 1 To 0 Step -1
xV = xLstBox.List(I)
For J = 0 To UBound(xArr)
If xArr(J) = xV Then
xLstBox.Selected(I) = True
Exit For
End If
Next
Next I
End If
Else
xLstBox.Visible = False
For I = xLstBox.ListCount - 1 To 0 Step -1
If xLstBox.Selected(I) = True Then
xSelLst = xLstBox.List(I) & "; " & xSelLst
End If
Next I
If xSelLst <> "" Then
Range(texte1) = Mid(xSelLst, 1, Len(xSelLst) - 2)
Else
Range(texte1) = ""
End If
End If
End Sub
This comment was minimized by the moderator on the site
Hi Eloi,The code you provided doesn't seem to work. I have modified it again as below.  After adding the code in your Sheet(Code) window, go back to the worksheet, click the cell C4 to expand the list box, after selecting items from the list box, click on any cell in the worksheet to output the selection, and no separator is displayed when you select only one item in the list.
<div data-tag="code">Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Updated by Extendoffice 20211223
Dim xSelLst As Variant, I, J As Integer
Dim xV As String
Set xLstBox = ActiveSheet.ListBox1

If Target.Address = "$C$4" Then


If xLstBox.Visible = False Then
xLstBox.Visible = True
xStr = ""
xStr = Range("ListBoxOutput").Value

If xStr <> "" Then
xArr = Split(xStr, ";")
For I = xLstBox.ListCount - 1 To 0 Step -1
xV = xLstBox.List(I)
For J = 0 To UBound(xArr)
If xArr(J) = xV Then
xLstBox.Selected(I) = True
Exit For
End If
Next
Next I
End If

End If

Else
xLstBox.Visible = False

For I = xLstBox.ListCount - 1 To 0 Step -1
If xLstBox.Selected(I) = True Then
xSelLst = xLstBox.List(I) & "; " & xSelLst
End If
Next I
If xSelLst <> "" Then
Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 2)
Else
Range("ListBoxOutput") = ""
End If


End If

End Sub
This comment was minimized by the moderator on the site
Thanks a lot Crystal
This comment was minimized by the moderator on the site
Bonjour,Je suis plus que novice sur excel étant sur mac je ne peux utiliser l'outil Kutools j'ai donc tenté de créer une liste déroulante où l'on peut cocher plusieurs items mais je bloque dès le début dans l'onglet développeur puisque je n'ai pas du tout l'outil "insert".Merci pour votre aide
This comment was minimized by the moderator on the site
Hi I am newbie to VBA. I tried to execute the code but i get the following error "Run-time error '-2147024809 (80070057)': The Item with the specified name wasn't found". Can you help me with this
This comment was minimized by the moderator on the site
Hi Gowtham,It seem that this error occurs when you running the code directly in the Code editor (the Microsoft Visual Basic for Applications window).After adding the code, please press the Alt + Q keys to close the Microsoft Visual Basic for Applications window. Go back to the worksheet and execute the code by clicking the rectangle button (see the .gif picture in step 6).
This comment was minimized by the moderator on the site
Hi Crystal, even after your tip am getting same error as Gowtham. My error is right after protect my sheet. Would you please help me with this issue?
This comment was minimized by the moderator on the site
Hi Crystal, Even After your tip I am getting same error as Gowtham.
This comment was minimized by the moderator on the site
Hi Mina,Which Excel and Windows version are you using?
This comment was minimized by the moderator on the site
Hello,I added this code to an existing macro template and it is loading the selections correctly, but it is NOT clearing out the x on the selected items..This will be used on/in a template worksheet that has submit button/macro to load the worksheet answers into a hidden worksheet with a data table.And am happy to say the field data loaded to the cell, transferred into my variable, and loaded to the data table as expected.
This code was a HUGE blessing!
I use excel 2016
How do I fix this. I am using this version from below.
Sub Rectangle1_Click()
'Updated by Extendoffice 20200730
Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer
Dim xV As String
Set xSelShp = ActiveSheet.Shapes(Application.Caller)
Set xLstBox = ActiveSheet.ListBox1
If xLstBox.Visible = False Then
xLstBox.Visible = True
xSelShp.TextFrame2.TextRange.Characters.Text = "Pickup Options"
xStr = ""
xStr = Range("ListBoxOutput").Value

If xStr <> "" Then
xArr = Split(xStr, ";")
For I = xLstBox.ListCount - 1 To 0 Step -1
xV = xLstBox.List(I)
For J = 0 To UBound(xArr)
If xArr(J) = xV Then
xLstBox.Selected(I) = True
Exit For
End If
Next
Next I
End If
Else
xLstBox.Visible = False
xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"
For I = xLstBox.ListCount - 1 To 0 Step -1
If xLstBox.Selected(I) = True Then
xSelLst = xLstBox.List(I) & ";" & xSelLst
End If
Next I
If xSelLst <> "" Then
Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 1)
Else
Range("ListBoxOutput") = ""
End If
End If
End Sub
This comment was minimized by the moderator on the site
Hello,

I'm having a similar problem to Tom from 2 months ago. When I try to share my file with a colleague, the multi-select droplist list isn't working. However, I used the Kutools add-on to create this as opposed to creating it myself. I've also saved it as macro-enabled.
This comment was minimized by the moderator on the site
Hi ben,The multi-select drop down list feature of Kutools only works in the Excel that installed our Kutools. We are working on this issue, sorry for the inconvenience.
This comment was minimized by the moderator on the site
Hello I looking the resolve for problem with saving choosing on drop down list

when i choose something on list and send file to my colleague, then when he open file and want to check my list then list has cleared and cell "ListBoxOutput" was cleared too.

help please :)
This comment was minimized by the moderator on the site
Hi Tom,
Please save the workbook as an "Excel MacroEnable Workbook" and then send this .xlsm file to your colleague.
This comment was minimized by the moderator on the site
hello i save this file in this format from beginning ;), but without effect. still when i fill file and send to someone then when he opened file and click to "shape" then macro started from begin and cleared list
This comment was minimized by the moderator on the site
Hi Tom,
I am sorry for the mistake. The code has been updated again. Please have a try.

Sub Rectangle1_Click()

'Updated by Extendoffice 20200730

Dim xSelShp As Shape, xSelLst As Variant, I, J As Integer

Dim xV As String

Set xSelShp = ActiveSheet.Shapes(Application.Caller)

Set xLstBox = ActiveSheet.ListBox1

If xLstBox.Visible = False Then

xLstBox.Visible = True

xSelShp.TextFrame2.TextRange.Characters.Text = "Pickup Options"

xStr = ""

xStr = Range("ListBoxOutput").Value



If xStr <> "" Then

xArr = Split(xStr, ";")

For I = xLstBox.ListCount - 1 To 0 Step -1

xV = xLstBox.List(I)

For J = 0 To UBound(xArr)

If xArr(J) = xV Then

xLstBox.Selected(I) = True

Exit For

End If

Next

Next I

End If

Else

xLstBox.Visible = False

xSelShp.TextFrame2.TextRange.Characters.Text = "Select Options"

For I = xLstBox.ListCount - 1 To 0 Step -1

If xLstBox.Selected(I) = True Then

xSelLst = xLstBox.List(I) & ";" & xSelLst

End If

Next I

If xSelLst <> "" Then

Range("ListBoxOutput") = Mid(xSelLst, 1, Len(xSelLst) - 1)

Else

Range("ListBoxOutput") = ""

End If

End If

End Sub
This comment was minimized by the moderator on the site
Now it's working perfectly.

Many thanks for your help
There are no comments posted here yet
Load More
Please leave your comments in English
Posting as Guest
×
Rate this post:
0   Characters
Suggested Locations