Pessoal, tem possibilidade de uma macro ser executada em itens selecionados de uma listbox?
Já tenho quase tudo montado mas não sei como aplicar a macro sem ser na planilha ativa...
A primeira listbox me da a opção de surfar entre as planilhas para que eu posso verificar se realmente quero altera-lá, a segunda listbox foi criada com o intuito de marcar seleções diferentes para a macro de alteração só rodar nessa seleção, mas é aqui que eu me perco... Como fazer isso...
Código: Selecionar todos
Private Sub CommandButton1_Click()
On Error GoTo Erro
Cells.Find(What:="108478", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.FormulaR1C1 = "503281"
'LOCALIZA O COMPONENTE A SER ALTERADO E EXECUTA A ALTERAÇÃO
Range("G3").Select
ActiveCell.FormulaR1C1 = "08/05/2020"
'MUDA A DATA (MÊS/DIA/ANO)
Range("D3").Select
Exit Sub
Erro:
msg = MsgBox("O Seguinte erro ocorreu: " & Err.Description)
End Sub
Private Sub CommandButton4_Click()
Dim currentFind As Excel.Range
Dim firstFind As Excel.Range
Dim lQtdePlan As Integer
Dim lPlanAtual As Integer
Dim lPlanFim As Boolean
lQtdePlan = Worksheets.Count
lPlanAtual = 1
lPlanFim = False
listResultado.Clear
While lPlanAtual <= lQtdePlan
Set currentFind = Worksheets(lPlanAtual).Range("A1:Z30").Find(txtPesquisa.Text, , _
Excel.XlFindLookIn.xlValues, Excel.XlLookAt.xlPart, _
Excel.XlSearchOrder.xlByRows, Excel.XlSearchDirection.xlNext, False)
Set firstFind = Nothing
While Not currentFind Is Nothing And lPlanFim = False
If firstFind Is Nothing Then
Set firstFind = currentFind
ElseIf currentFind.Address = firstFind.Address Then
lPlanFim = True
End If
If lPlanFim = False Then
Set currentFind = Worksheets(lPlanAtual).Range("A1:Z30").FindNext(currentFind)
listResultado.AddItem (Worksheets(lPlanAtual).Name & "!" & currentFind.Address)
End If
If lPlanFim = False Then
Set currentFind = Worksheets(lPlanAtual).Range("A1:Z30").FindNext(currentFind)
ListBox1.AddItem (Worksheets(lPlanAtual).Name & "!" & currentFind.Address)
End If
Wend
lPlanAtual = lPlanAtual + 1
lPlanFim = False
Wend
Sair:
Exit Sub
End Sub
Private Sub CommandButton5_Click()
'''
'Remover item
'''
'Remove item selecionado da lista 1
Dim i As Long, contador As Long
Dim vetor() As Variant
With Me
For i = .ListBox1.ListCount - 1 To 0 Step -1
If .ListBox1.Selected(i) Then
ReDim Preserve vetor(contador)
msg = msg & vbCrLf & .ListBox1.List(i)
vetor(contador) = i
contador = contador + 1
End If
Next i
resposta = MsgBox("Deseja alterar o item a seguir? " & msg, vbYesNo + vbQuestion, "Alterar?")
If vbYes Then
Alteraitem
End If
End With
End Sub
Sub Alteraitem()
'''
'Alterar item
'''
'Se houver um item selecionado no ListBox
'e o mesmo tiver o indice diferente de -1 (sem item selecionado)
If ListBox1.ListIndex <> -1 Then
'Perguntamos se devemos prosseguir com a remoção do item selecioando
If MsgBox("Deseja alterar o item selecionado?", vbQuestion + vbYesNo, "Alterar item?") = vbYes Then
'Deletamos a linha seleciona inteira
On Error GoTo Erro
'Se ocorrer algum erro irá chamar o tratamento Erro
Cells.Find(What:="108478", After:=ActiveCell, LookIn:=xlFormulas2, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.FormulaR1C1 = "503281"
'LOCALIZA O COMPONENTE A SER ALTERADO E EXECUTA A ALTERAÇÃO
Range("G3").Select
ActiveCell.FormulaR1C1 = "08/05/2020"
'MUDA A DATA (MÊS/DIA/ANO)
MsgBox "Item alterado com sucesso!", vbInformation, "Alterado"
'Definimos o indice do ListBox nenhum (-1)
ListBox1.ListIndex = -1
End If
Else
'Se não houver item selecionado,
'Notificamos o usuário
MsgBox "Nenhum item selecionado na lista!", vbExclamation, "Erro"
End If
Exit Sub
Erro:
'Tratamento de erro GoTo
msg = MsgBox("O Seguinte erro ocorreu: " & Err.Description)
End Sub
Private Sub ListBox1_Click()
End Sub
Private Sub listResultado_Click()
Dim lRng As Range
Dim lEndereco() As String
lEndereco = Split(listResultado, "!")
Worksheets(lEndereco(0)).Activate
Set lRng = Range(lEndereco(1))
lRng.Activate
End Sub