none
Evento dblclick não funciona em Excel + Vba RRS feed

  • Pergunta

  • Pessoal,

    Estou trabalhando em um projeto em excel com VBA, para gerar ordem de compra. Estou com dois formulários, sendo um para cadastro da ordem de compra e outro para pesquisa e filtro das mesmas. O meu problema está no formulário de filtro e pesquisa, onde tenho um evento que quando clico duas vezes no item pesquisado ele deve retornar ao formulário de cadastro. O código estava funcionando, no entanto, simplesmente parou de funcionar, não aparece nenhum erro, ou seja, o duplo clique é dado o formulário fecha e os dados não voltam para o formulário de cadastro.

    Tenho pouco conhecimento em VBA, apenas o básico mesmo, mas tenho muita curiosidade e vou aprendendo nessas. Se puderem me ajudar a encontrar o problema ficarei muito grata. Abaixo segue o trecho do código que apresenta o problema.

    Private Sub lstv_dblClick()
    
        frmOrçamento.lstv.ListItems.Clear
    
        For i = 2 To Worksheets("Plan2").UsedRange.Rows.Count
            If CInt(Plan2.Cells(i, 1)) = CInt(Me.lstv.SelectedItem.ListSubItems(1)) And _
            Plan2.Cells(i, 3) = Me.lstv.SelectedItem.ListSubItems(2) Then
                      
              With frmOrçamento
                .lblNro.Caption = Format(Plan2.Cells(i, 1), "0,00")
                txtData = Plan2.Cells(i, 2)
                txtObra = Plan2.Cells(i, 3)
                txtContrato = Plan2.Cells(i, 4)
                txtCliente = Plan2.Cells(i, 5)
                txtObservaçoes = Plan2.Cells(i, 6)
                txtCnpj = Plan2.Cells(i, 7)
                txtCidade = Plan2.Cells(i, 8)
                txtContato = Plan2.Cells(i, 9)
                txtTelefone = Plan2.Cells(i, 10)
                txtIcms = Plan2.Cells(i, 11)
                txtIpi = Plan2.Cells(i, 12)
                txtFrete = Plan2.Cells(i, 13)
                txtPrazo = Plan2.Cells(i, 14)
                txtPag = Plan2.Cells(i, 15)
                .lstv.ListItems.Add 1, , CInt(Plan2.Cells(i, 16))
                .lstv.ListItems(1).ListSubItems.Add 1, , Plan2.Cells(i, 17)
                .lstv.ListItems(1).ListSubItems.Add 2, , Plan2.Cells(i, 18)
                .lstv.ListItems(1).ListSubItems.Add 3, , Format(Plan2.Cells(i, 19), "Currency")
                .lstv.ListItems(1).ListSubItems.Add 4, , Format(Plan2.Cells(i, 20), "Currency")
                            
                If Plan2.Cells(i, 21) = 1 Then
                    .optDesconto.Value = True
                ElseIf Plan2.Cells(i, 21) = 2 Then
                    .optAcrescimo.Value = True
                End If
                .txtDesc = Format(Plan2.Cells(i, 22), "0")
                .EfetuarCalculos
                .Calc_Desc_Acresc
    
                .btnApagar.Enabled = True
                .btnImprimir.Enabled = True
              End With
            End If
        Next
        
       ' Unload Me
        Me.Hide
        
    End Sub

    Desde já agradeço,

    Rafaela

    sábado, 23 de agosto de 2014 18:30