APLICAR MACRO EM SELEÇÃO DE LISTBOX QUE ESTÃO EM PLANILHAS DIFERENTES.
Enviado: Qua Ago 12, 2020 2:34 pm
Boa tarde!
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...
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