Ir para o conteúdo principal

Como criar uma lista suspensa com várias caixas de seleção no Excel?

Muitos usuários do Excel tendem a criar uma lista suspensa com várias caixas de seleção para selecionar vários itens da lista por vez. Na verdade, você não pode criar uma lista com várias caixas de seleção com a validação de dados. Neste tutorial, vamos mostrar a você dois métodos para criar uma lista suspensa com várias caixas de seleção no Excel.

Use a caixa de listagem para criar uma lista suspensa com várias caixas de seleção
R: Crie uma caixa de listagem com dados de origem
B: Nomeie a célula na qual você localizará os itens selecionados
C: Insira uma forma para ajudar na saída dos itens selecionados
Crie facilmente uma lista suspensa com caixas de seleção com uma ferramenta incrível
Mais tutoriais para a lista suspensa ...


Use a caixa de listagem para criar uma lista suspensa com várias caixas de seleção

Conforme a captura de tela mostrada abaixo, na planilha atual, todos os nomes no intervalo A2: A11 serão os dados de origem da caixa de listagem. Clicar no botão na célula C4 pode gerar os itens selecionados, e todos os itens selecionados na caixa de listagem serão exibidos na célula E4. Para conseguir isso, faça o seguinte.

A. Crie uma caixa de listagem com dados de origem

1. Clique Developer > inserção > Caixa de listagem (controle Active X). Veja a imagem:

2. Desenhe uma caixa de lista na planilha atual, clique com o botão direito nela e selecione Propriedades no menu do botão direito.

3. No Propriedades caixa de diálogo, você precisa configurar da seguinte maneira.

  • 3.1 no ListFillRange caixa, insira o intervalo de origem que você exibirá na lista (aqui eu insiro o intervalo A2: A11);
  • 3.2 no Estilo de lista caixa, selecione 1 - opção de estilo fmList;
  • 3.3 no MultiSelect caixa, selecione 1 - fmMultiSelectMulti;
  • 3.4 Feche o Propriedades caixa de diálogo. Veja a imagem:

B: Nomeie a célula na qual você localizará os itens selecionados

Se você precisar imprimir todos os itens selecionados em uma célula especificada, como E4, faça o seguinte.

1. Selecione a célula E4, digite Saída de ListBox no nome Box e pressione o botão Entrar chave.

C. Insira uma forma para ajudar na saída dos itens selecionados

1. Clique inserção > Formas > Retângulo. Veja a imagem:

2. Desenhe um retângulo em sua planilha (aqui eu desenho o retângulo na célula C4). Em seguida, clique com o botão direito no retângulo e selecione Atribuir Macro no menu do botão direito.

3. No Atribuir Macro caixa de diálogo, clique no botão Novo botão.

4. Na abertura Microsoft Visual Basic para Aplicações janela, substitua o código original no Módulo janela com o código VBA abaixo.

Código VBA: crie uma lista com várias caixas de seleção

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

Observação: No código, Retângulo 1 é o nome da forma; ListBox1 é o nome da caixa de listagem; Selecione as opções e Opções de coleta são os textos exibidos da forma; e a Saída de ListBox é o nome do intervalo da célula de saída. Você pode alterá-los de acordo com suas necessidades.

5. Pressione outro + Q simultaneamente para fechar o Microsoft Visual Basic para Aplicações janela.

6. Clique no botão retângulo para dobrar ou expandir a caixa de listagem. Quando a caixa de listagem estiver se expandindo, verifique os itens na caixa de listagem e clique no retângulo novamente para enviar todos os itens selecionados para a célula E4. Veja a demonstração abaixo:

7. Em seguida, salve a pasta de trabalho como um Pasta de trabalho Excel MacroEnable para reutilizar o código no futuro.


Crie uma lista suspensa com caixas de seleção com uma ferramenta incrível

O método acima é muito multifacetado para ser manuseado facilmente. Aqui recomendo fortemente o Lista suspensa com caixas de seleção utilidade de Kutools para Excel para ajudá-lo a criar facilmente uma lista suspensa com caixas de seleção em um intervalo especificado, planilha atual, pasta de trabalho atual ou todas as pastas de trabalho abertas com base em suas necessidades. Veja a demonstração abaixo:
Baixe e experimente agora! (trilha gratuita de 30 dias)

Além da demonstração acima, também fornecemos um guia passo a passo para demonstrar como aplicar esse recurso para realizar essa tarefa. Faça o seguinte.

1. Abra a planilha que você definiu na lista suspensa de validação de dados e clique em Kutools > Lista suspensa > Lista suspensa com caixas de seleção > Configurações. Veja a imagem:

2. No Lista suspensa com configurações de caixas de seleção caixa de diálogo, configure como segue.

  • 2.1) No Aplicar a seção, especifique o escopo de aplicação onde você criará caixas de seleção para itens na lista suspensa. Você pode especificar um certa gama, planilha atual, pasta de trabalho atual or todas as pastas de trabalho abertas com base em suas necessidades.
  • 2.2) No Moda seção, escolha um estilo que você deseja para a saída dos itens selecionados;
  • Aqui leva o modificar como um exemplo, se você escolher esta, o valor da célula será alterado com base nos itens selecionados.
  • 2.3) No separador caixa, insira um delimitador que você usará para separar os vários itens;
  • 2.4) No Direção do texto seção, selecione uma direção de texto com base em suas necessidades;
  • 2.5) Clique no OK botão.

3. A última etapa, clique em Kutools > Lista suspensa > Lista suspensa com caixas de seleção > Habilitar lista suspensa de caixas de seleção para ativar esse recurso.

De agora em diante, quando você clicar nas células com lista suspensa em um escopo especificado, uma caixa de lista aparecerá, selecione os itens marcando as caixas de seleção para produzir na célula como mostrado na demonstração abaixo (tome o modo Modificar como exemplo )

Para obter mais detalhes sobre esse recurso, por favor visite aqui.

  Se você quiser ter um teste gratuito (30 dias) deste utilitário, por favor clique para fazer o downloade, em seguida, aplique a operação de acordo com as etapas acima.


Artigos relacionados:

Preenchimento automático ao digitar na lista suspensa do Excel
Se você tiver uma lista suspensa de validação de dados com valores grandes, precisará rolar para baixo na lista apenas para encontrar o apropriado ou digitar a palavra inteira diretamente na caixa de listagem. Se houver um método para permitir o preenchimento automático ao digitar a primeira letra da lista suspensa, tudo ficará mais fácil. Este tutorial fornece o método para resolver o problema.

Crie uma lista suspensa de outra pasta de trabalho no Excel
É muito fácil criar uma lista suspensa de validação de dados entre as planilhas de uma pasta de trabalho. Mas se os dados da lista de que você precisa para a validação de dados estiverem em outra pasta de trabalho, o que você faria? Neste tutorial, você aprenderá como criar uma lista suspensa de outra pasta de trabalho no Excel em detalhes.

Crie uma lista suspensa pesquisável no Excel
Para uma lista suspensa com vários valores, encontrar um adequado não é um trabalho fácil. Anteriormente, introduzimos um método de preenchimento automático da lista suspensa ao inserir a primeira letra na caixa suspensa. Além da função de preenchimento automático, você também pode tornar a lista suspensa pesquisável para aumentar a eficiência de trabalho ao encontrar os valores adequados na lista suspensa. Para tornar a lista suspensa pesquisável, tente o método neste tutorial.

Preencher automaticamente outras células ao selecionar valores na lista suspensa do Excel
Digamos que você tenha criado uma lista suspensa com base nos valores do intervalo de células B8: B14. Ao selecionar qualquer valor na lista suspensa, você deseja que os valores correspondentes no intervalo de células C8: C14 sejam preenchidos automaticamente em uma célula selecionada. Para resolver o problema, os métodos neste tutorial vão lhe fazer um favor.

Mais tutoriais para a lista suspensa ...

Melhores ferramentas de produtividade de escritório

🤖 Assistente de IA do Kutools: Revolucionar a análise de dados com base em: Execução Inteligente   |  Gerar Código  |  Crie fórmulas personalizadas  |  Analise dados e gere gráficos  |  Invocar funções do Kutools...
Recursos mais comuns: Encontre, destaque ou identifique duplicatas   |  Excluir linhas em branco   |  Combine colunas ou células sem perder dados   |   Rodada sem Fórmula ...
Super pesquisa: VLookup de múltiplos critérios    VLookup de múltiplos valores  |   VLookup em várias planilhas   |   Pesquisa Difusa ....
Lista suspensa avançada: Crie rapidamente uma lista suspensa   |  Lista suspensa de dependentes   |  Lista suspensa de seleção múltipla ....
Gerenciador de colunas: Adicione um número específico de colunas  |  Mover colunas  |  Alternar status de visibilidade de colunas ocultas  |  Compare intervalos e colunas ...
Recursos em destaque: Foco da Grade   |  Vista de Design   |   Grande Barra de Fórmula    Gerenciador de pastas de trabalho e planilhas   |  Biblioteca (Auto texto)   |  Data Picker   |  Combinar planilhas   |  Criptografar/Descriptografar Células    Enviar e-mails por lista   |  Super Filtro   |   Filtro Especial (filtro negrito/itálico/tachado...) ...
15 principais conjuntos de ferramentas12 Texto Ferramentas (Adicionar texto, Remover Personagens, ...)   |   50+ de cores Tipos (Gráfico de Gantt, ...)   |   Mais de 40 práticos Fórmulas (Calcule a idade com base no aniversário, ...)   |   19 Inclusão Ferramentas (Insira o código QR, Inserir imagem do caminho, ...)   |   12 Conversão Ferramentas (Números para Palavras, Conversão de moedas, ...)   |   7 Unir e dividir Ferramentas (Combinar linhas avançadas, Dividir células, ...)   |   ... e mais

Aprimore suas habilidades de Excel com o Kutools para Excel e experimente uma eficiência como nunca antes. Kutools para Excel oferece mais de 300 recursos avançados para aumentar a produtividade e economizar tempo.  Clique aqui para obter o recurso que você mais precisa...

Descrição


Office Tab traz interface com guias para o Office e torna seu trabalho muito mais fácil

  • Habilite a edição e leitura com guias em Word, Excel, PowerPoint, Publisher, Access, Visio e Project.
  • Abra e crie vários documentos em novas guias da mesma janela, em vez de em novas janelas.
  • Aumenta sua produtividade em 50% e reduz centenas de cliques do mouse para você todos os dias!
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