Excel Msgbox retornando um valor contido em uma célula

marcospires1 · 26 de junho de 2022

Pessoal mais uma vez preciso de ajuda.

Estou precisando fazer uma macro que quando um valor é digitado em qualquer intervalo entre A12:A40 da aba "Pedido", a mesma busque este valor na aba "Impostos" na coluna E, e seja apresentado em uma Msgbox.

Por exemplo:

Na minha aba pedido eu digito um código de produto na celula A12, por exemplo código "10" que é de uma caixa fechada de café. Na Msgbox eu preciso que apareça a quantidade total de café contida na caixa. A informação da quantidade está contida na aba Impostos. E assim sucessivamente na linhas abaixo, A13, A14.....

Por favor poderiam me ajudar?

Midori · 27 de junho de 2022

@marcospires1 Anexe uma planilha onde seja possível testar esses resultados.

marcospires1 · 28 de junho de 2022

@Midori Boa noite, obrigado desde já com a ajuda.

Segue

PLANILHA PEDIDO.rar

Midori · 28 de junho de 2022

@marcospires1 Cole no módulo da planilha Pedido e entre com o código no Range para testar,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, [A12:A40]) Is Nothing Then
        Dim Quantidade As String
        
        Quantidade = Busca(Target)
        
        If Quantidade <> "" Then
            MsgBox "Quantidade = " & Quantidade
        End If
    End If
End Sub

Function Busca(ByVal Codigo As String) As String
    Dim Celula As Range
    
    Set Celula = ThisWorkbook.Sheets("Impostos").[A:A].Find( _
        What:=Codigo, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not Celula Is Nothing Then
        Busca = Celula.Offset(0, 4).Value
    End If
End Function

marcospires1 · 28 de junho de 2022

@Midori Funcionou perfeitamente. Muito obrigado Midori.

marcospires1 · 6 de julho de 2022

Em 28/06/2022 às 08:44, Midori disse:

@marcospires1 Cole no módulo da planilha Pedido e entre com o código no Range para testar,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, [A12:A40]) Is Nothing Then
        Dim Quantidade As String
        
        Quantidade = Busca(Target)
        
        If Quantidade <> "" Then
            MsgBox "Quantidade = " & Quantidade
        End If
    End If
End Sub

Function Busca(ByVal Codigo As String) As String
    Dim Celula As Range
    
    Set Celula = ThisWorkbook.Sheets("Impostos").[A:A].Find( _
        What:=Codigo, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not Celula Is Nothing Then
        Busca = Celula.Offset(0, 4).Value
    End If
End Function

@Midori

Ficou muito top o código e agradeço muito por isso, porém eu estive vendo algumas coisas e estou com o código abaixo.

Ele cria um Popup "personalizado". E minha dúvida é a seguinte será que consigo utilizar o código que você me passou para este Popup, assim eu teria a informação somente quando tivesse dúvida.

Consegue me ajudar nessa também?

Sub CriarPopUp()

Dim Mrs As CommandBar

CommandBars("PopUpPersonalizado").Delete

Set Mrs = CommandBars.Add("PopUpPersonalizado", msoBarPopup)

With Mrs
    
    With .Controls.Add(msoControlButton)
    
        .Caption = "Quantidade Caixa Master"
        .FaceId = 1394
        .OnAction = "CaixaMaster"
        
    End With

End With

End Sub

Sub CaixaMaster()



End Function

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

CommandBars("PopUpPersonalizado").ShowPopup
Cancel = True

End Sub

Midori · 6 de julho de 2022

@marcospires1 A sub CriaPopUp só precisa ser executada uma vez ao abrir a planilha,

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Not Application.Intersect(Target, [A12:A40]) Is Nothing Then
        Dim Quantidade As String
        
        Quantidade = Busca(Target)
        
        If Quantidade <> "" Then
            Call MostraPopUp(Quantidade)
        End If
        Cancel = True
    End If
End Sub

Function Busca(ByVal Codigo As String) As String
    Dim Celula As Range
    
    Set Celula = ThisWorkbook.Sheets("Impostos").[A:A].Find( _
        What:=Codigo, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not Celula Is Nothing Then
        Busca = Celula.Offset(0, 4).Value
    End If
End Function

Sub CaixaMaster()

End Sub

Sub CriaPopUp()
    Dim Controle As CommandBar
    
    On Error GoTo Adiciona
    CommandBars("PopUpPersonalizado").Delete

Adiciona:
    Set Controle = CommandBars.Add("PopUpPersonalizado", msoBarPopup)
    On Error GoTo 0
    
    With Controle.Controls.Add(msoControlButton)
        .FaceId = 1394
        .OnAction = "CaixaMaster"
    End With
End Sub

Sub MostraPopUp(Quantidade As String)
    Dim Controle As CommandBar
    Set Controle = CommandBars("PopUpPersonalizado")
    Controle.Controls(1).Caption = "Quantidade = " & Quantidade
    Controle.ShowPopup
End Sub

marcospires1 · 7 de julho de 2022

@Midori Ficou show, mas será que pode dar problema com versão do Office?

Pois consigo abrir em um pc (office mais atual), e no outro (office 2013) da erro em tempo de execução 5.

Sabe o que pode causar isso?

Em 28/06/2022 às 08:44, Midori disse:

@marcospires1 Cole no módulo da planilha Pedido e entre com o código no Range para testar,

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Application.Intersect(Target, [A12:A40]) Is Nothing Then
        Dim Quantidade As String
        
        Quantidade = Busca(Target)
        
        If Quantidade <> "" Then
            MsgBox "Quantidade = " & Quantidade
        End If
    End If
End Sub

Function Busca(ByVal Codigo As String) As String
    Dim Celula As Range
    
    Set Celula = ThisWorkbook.Sheets("Impostos").[A:A].Find( _
        What:=Codigo, LookIn:=xlValues, LookAt:=xlWhole)
    
    If Not Celula Is Nothing Then
        Busca = Celula.Offset(0, 4).Value
    End If
End Function

@Midori

Ficou muito top o código e agradeço muito por isso, porém eu estive vendo algumas coisas e estou com o código abaixo.

Ele cria um Popup "personalizado". E minha dúvida é a seguinte será que consigo utilizar o código que você me passou para este Popup, assim eu teria a informação somente quando tivesse dúvida.

Consegue me ajudar nessa também?

Sub CriarPopUp()

Dim Mrs As CommandBar

CommandBars("PopUpPersonalizado").Delete

Set Mrs = CommandBars.Add("PopUpPersonalizado", msoBarPopup)

With Mrs
    
    With .Controls.Add(msoControlButton)
    
        .Caption = "Quantidade Caixa Master"
        .FaceId = 1394
        .OnAction = "CaixaMaster"
        
    End With

End With

End Sub

Sub CaixaMaster()



End Function

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

CommandBars("PopUpPersonalizado").ShowPopup
Cancel = True

End Sub

Midori · 8 de julho de 2022

13 horas atrás, marcospires1 disse:

será que pode dar problema com versão do Office?

A macro roda em versões mais antigas também. Em qual linha dá esse erro?

marcospires1 · 8 de julho de 2022

Em 06/07/2022 às 08:52, Midori disse:
 Set Controle = CommandBars("PopUpPersonalizado")

@Midori se não me engano é este, não estou com o pc que está dando o erro aqui comigo.

Confirmei é esse mesmo.

Midori · 11 de julho de 2022

@marcospires1 O erro nessa linha é porque o CommandBar não foi adicionado, então faltou executar a sub CriaPopUp antes como comentei no post da macro. Para não ter esse problema você pode chamar a Sub em Workbook Open e se quiser remover ao sair coloque Delete em BeforeClose.

marcospires1 · 12 de julho de 2022

13 horas atrás, Midori disse:

@marcospires1 O erro nessa linha é porque o CommandBar não foi adicionado, então faltou executar a sub CriaPopUp antes como comentei no post da macro. Para não ter esse problema você pode chamar a Sub em Workbook Open e se quiser remover ao sair coloque Delete em BeforeClose.

Perfeito @Midori funcionou de boa. Obrigado pela atenção.