Bom Dia Pessoal,
Estou com uma dificuldade para Atualizar dados nos listview. Meu sistema lança bonitinho e a listview atualiza, porém só atualiza quando é um item novo add. Quando é um item já lançado, onde as colunas Qt e soma deveriam ser atualizadas, o listview não atualiza continuando com o mesmo valor anterior.
Não tive tempo de montar um modelo. Mas vou postar passo a passo. Não entendo o motivo de não atualizar.
1 - Crio as colunas no UserForm_Initialize()
Private Sub UserForm_Initialize()
Linh = 2
Do Until Sheets("LISTA").Cells(Linh, 1) = ""
Linh = Linh + 1
Loop
' Adiciona as colunas
With lstprodutoslancados
.ColumnHeaders.Clear
.Gridlines = True
.View = lvwReport
.FullRowSelect = True
.ColumnHeaders.Add Text:="ID"
.ColumnHeaders.Add Text:="SEQKIT"
.ColumnHeaders.Add Text:="COD"
.ColumnHeaders.Add Text:="QT"
.ColumnHeaders.Add Text:="PRODUTO"
.ColumnHeaders.Add Text:="DESCRIÇÃO"
.ColumnHeaders.Add Text:="VALOR"
.ColumnHeaders.Add Text:="SOMA"
End With
End Sub
2 - Carrego os dados para lançamento
Private Sub cbpesquisar_Click()
Application.ScreenUpdating = False
Dim bPesq As Boolean
Dim i As Integer
bPesq = False
i = 2
Do Until Worksheets("ADM FICHAS").Cells(i, 1) = ""
If Val(Worksheets("ADM FICHAS").Cells(i, 1)) = Val(cbsequencia.Value) Then
bPesq = True
Exit Do
End If
i = i + 1
Loop
If Not bPesq Then
MsgBox "Sequência " & cbsequencia & " não encontrada", vbOKOnly, ""
cbsequencia.SetFocus
Exit Sub
End If
Me.cbsequencia.Value = Worksheets("ADM FICHAS").Cells(i, 1)
Me.txtcodkit.Value = Worksheets("ADM FICHAS").Cells(i, 2)
Me.txtmatricula.Value = Worksheets("ADM FICHAS").Cells(i, 3)
Me.txtrevendedor.Value = Worksheets("ADM FICHAS").Cells(i, 4)
Me.txtstatus.Text = Worksheets("ADM FICHAS").Cells(i, 20)
If Me.txtstatus = "SIM" Then
Me.txtstatus = "ENCERRADO"
Else:
Me.txtstatus = "ABERTO"
End If
Worksheets("LISTA").Select
If Me.cbsequencia = "" Then
MsgBox "Escolher uma sequência"
Me.cbsequencia.SetFocus
Exit Sub
End If
If Me.txtcodkit = "" Then
MsgBox "É necessário executar o botão pesquisa '...'"
Me.cbpesquisar.SetFocus
Exit Sub
End If
Sheets("LISTA").Range("A4:H5000").ClearContents
Lin = 2
Linha = 4
Do Until Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 2) = ""
If Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 2) Like Me.cbsequencia Then _
Sheets("LISTA").Cells(Linha, 1) = Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 1)
Sheets("LISTA").Cells(Linha, 2) = Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 2)
Sheets("LISTA").Cells(Linha, 3) = Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 3)
Sheets("LISTA").Cells(Linha, 4) = Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 4)
Sheets("LISTA").Cells(Linha, 5) = Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 5)
Sheets("LISTA").Cells(Linha, 6) = Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 6)
Sheets("LISTA").Cells(Linha, 7) = Sheets("ADM FICHAS MERCADORIA").Cells(Lin, 7)
Sheets("LISTA").Cells(Linha, 8) = Cells(Linha, 4) * Cells(Linha, 7)
Linha = Linha + 1
End If
Lin = Lin + 1
Loop
'------------------------------------------------------------------
Me.txtgruposoma = Clear
Me.txtgrupo1 = Clear
Me.txtgrupo2 = Clear
Me.txtgrupo3 = Clear
Me.txtgrupo4 = Clear
Me.txtgrupo5 = Clear
Me.txtgrupo6 = Clear
Me.txtgrupo7 = Clear
Me.txtgrupo_soma = Clear
Me.txtcodlancadoultimo = Clear
'ListView-------------------------------------------------------
'...................................................................
lstprodutoslancados.ListItems.Clear
' Adiciona itens
Dim Column As Long
Dim Counter As Long
Counter = 0
Column = Counter
Counter = lstprodutoslancados.ColumnHeaders.Count - 1
Set Ws = ThisWorkbook.Worksheets("LISTA")
For l = 4 To Ws.UsedRange.Rows.Count
SendMessage lstprodutoslancados.hWnd, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER
With Me.lstprodutoslancados
.ListItems.Add 1, , Ws.Cells(l, 1)
.ListItems(1).ListSubItems.Add 1, , Ws.Cells(l, 2)
.ListItems(1).ListSubItems.Add 2, , Ws.Cells(l, 3)
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 8)
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 7)
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 6)
.ListItems(1).ListSubItems.Add 3, , Format(Ws.Cells(l, 5), "Currency")
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 4)
End With
Next
Me.txtsomapecas = Ws.Cells(1, 2)
Me.txtvalorkit = Format(Ws.Cells(1, 6), "Currency")
3 - Lanço os produtos Aqui é um pouco complexo pois o produto é lançado em duas planilhas simultaneamente. As colunas a serem atualizadas no listview estão no final. É aqui que se eu lançar dois produtos identicos ocorre a falha. O primeiro lançamento atualiza normalmente o segundo não. Se eu quiser atualizar os dados tenho que carregar tudo novamente com o passo 2.
Private Sub txtcodproduto_a_Enter()
Application.ScreenUpdating = False
'condicionais necessários
If Me.cbsequencia = "" Or Me.txtcodkit = "" Or Me.txtmatricula = "" Or Me.txtrevendedor = "" Then
MsgBox "Escolha uma Sequência de KIT para Lançamento e clique no botão '...'", , ""
Me.txtcodprodutoauto = Clear
Me.cbsequencia.SetFocus
Exit Sub
End If
If Me.txtcodprodutoauto = "" Then
MsgBox "Digite um código de produto Valido, não pode ser '0' ou vazio", , ""
Me.txtcodprodutoauto = Clear
Me.txtcodprodutoauto.SetFocus
Exit Sub
End If
If Me.txtstatus = "ENCERRADO" Then
MsgBox "Seq. Kit já esta encerrado.", , ""
Me.txtcodprodutoauto = Clear
Me.txtcodprodutoauto.SetFocus
Exit Sub
End If
'declarações
i = 1
Dim lCodigo As Long
Dim lSequencia As Long
Dim lCodkit As Long
Dim lMatricula As Long
Dim lCodProduto As Long
Dim lQt As Long
Dim cValorunitario As Currency
Dim cValortotal As Currency
Dim cCustoUnitario As Currency
Dim cCustototal As Currency
Dim cValoratacado As Currency
'Localiza e soma caso encontrar um mesmo cod de produto
Sheets("LISTA").Select
bPesq = False
a = 3
If Me.txtcodprodutoauto = "" Then
txtcodprodutoauto.SetFocus
Exit Sub
End If
Do Until Cells(a, 3) = ""
If Val(Cells(a, 3)) = Val(Me.txtcodprodutoauto.Value) Then
bPesq = True
Exit Do
End If
a = a + 1
Loop
Cells(a, 1).Select
If Cells(a, 4) >= 1 Then
Cells(a, 4) = Cells(a, 4) + 1
Cells(a, 8) = Cells(a, 4) * Cells(a, 7)
End If
Sheets("ADM FICHAS MERCADORIA").Select
bPesq = False
If Me.txtcodprodutoauto = "" Then
txtcodprodutoauto.SetFocus
Exit Sub
End If
Do Until Cells(i, 3) = ""
If Val(Cells(i, 3)) = Val(Me.txtcodprodutoauto.Value) And Val(Cells(i, 2)) = Val(Me.cbsequencia.Value) Then
bPesq = True
Exit Do
End If
i = i + 1
Loop
If bPesq = True Then
Cells(i, 4) = Cells(i, 4) + 1
Cells(i, 8) = Cells(i, 4) * Cells(i, 7)
Cells(i, 10) = Cells(i, 4) * Cells(i, 9)
Me.txtcodlancadoultimo = Me.txtcodprodutoauto
If txtgruposoma = "" Then
txtgruposoma = 0
txtgruposoma = Me.txtgruposoma + 1
Else:
txtgruposoma = Me.txtgruposoma + 1
End If
txtcodprodutoauto = Clear
txtcodprodutoauto.SetFocus
Exit Sub
End If
'lançamento
'usando a variável vCodigo para memorizar a autonumeração
lCodigo = Sheets("ADM FICHAS MERCADORIA").Range("A60000").End(xlUp).Offset(0, 0).Value
Me.cmdsequencialancamento = lCodigo + 1
If Me.txtcustounitario = "" Then
MsgBox "Custo Unitário esta Vazio, favor corrigir antes de proceguir", , ""
Me.txtcodprodutoauto = Clear
Me.txtcodprodutoauto.SetFocus
Exit Sub
End If
lSequencia = Me.cbsequencia
lCodkit = Me.txtcodkit
lMatricula = Me.txtmatricula
lCodProduto = Me.txtcodprodutoauto
cValorunitario = Me.txtvalorunitario
cValortotal = Me.txtvalortotal
cCustoUnitario = Me.txtcustounitario
cCustototal = Me.txtcustototal
cValoratacado = Me.txtvaloratacado
lQt = 1
h = 3
Do Until Sheets("LISTA").Cells(h, 1) = ""
h = h + 1
Loop
Sheets("LISTA").Cells(h, 1) = Me.cmdsequencialancamento.Value
Sheets("LISTA").Cells(h, 2) = lSequencia
Sheets("LISTA").Cells(h, 3) = lCodProduto
Sheets("LISTA").Cells(h, 4) = lQt
Sheets("LISTA").Cells(h, 5) = Me.txtproduto
Sheets("LISTA").Cells(h, 6) = Me.txtdescricao
Sheets("LISTA").Cells(h, 7) = cValorunitario
Sheets("LISTA").Cells(h, 8) = lQt * cValorunitario
Do Until Sheets("ADM FICHAS MERCADORIA").Cells(i, 1) = ""
i = i + 1
Loop
Sheets("ADM FICHAS MERCADORIA").Cells(i, 1) = Me.cmdsequencialancamento.Value
Sheets("ADM FICHAS MERCADORIA").Cells(i, 2) = lSequencia
Sheets("ADM FICHAS MERCADORIA").Cells(i, 3) = lCodProduto
Sheets("ADM FICHAS MERCADORIA").Cells(i, 4) = lQt
Sheets("ADM FICHAS MERCADORIA").Cells(i, 5) = Me.txtproduto
Sheets("ADM FICHAS MERCADORIA").Cells(i, 6) = Me.txtdescricao
Sheets("ADM FICHAS MERCADORIA").Cells(i, 7) = cValorunitario
Sheets("ADM FICHAS MERCADORIA").Cells(i, 8) = cValortotal
Sheets("ADM FICHAS MERCADORIA").Cells(i, 9) = cCustoUnitario
Sheets("ADM FICHAS MERCADORIA").Cells(i, 10) = cCustototal
Sheets("ADM FICHAS MERCADORIA").Cells(i, 11) = cValoratacado
Sheets("ADM FICHAS MERCADORIA").Cells(i, 12) = Sheets("TABELAS").Cells(3, 1)
Me.txtcodlancadoultimo = lCodProduto
If txtgruposoma = "" Then
txtgruposoma = 0
txtgruposoma = Me.txtgruposoma + 1
Else:
txtgruposoma = Me.txtgruposoma + 1
End If
'limapa campo e foca o cursor para novo lançamento
Me.txtcodprodutoauto = Clear
Me.cmdsequencialancamento = Clear
Me.txtcodprodutoauto.SetFocus
' listview me.lstprodutoslancados --------------------------------------
'Limpa dados
lstprodutoslancados.ListItems.Clear
' Adiciona itens
Dim Column As Long
Dim Counter As Long
Counter = 0
Column = Counter
Counter = lstprodutoslancados.ColumnHeaders.Count - 1
Set Ws = ThisWorkbook.Worksheets("LISTA")
For l = 4 To Ws.UsedRange.Rows.Count
SendMessage lstprodutoslancados.hWnd, LVM_SETCOLUMNWIDTH, Column, LVSCW_AUTOSIZE_USEHEADER
With Me.lstprodutoslancados
.ListItems.Add 1, , Ws.Cells(l, 1)
.ListItems(1).ListSubItems.Add 1, , Ws.Cells(l, 2)
.ListItems(1).ListSubItems.Add 2, , Ws.Cells(l, 3)
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 8)
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 7)
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 6)
.ListItems(1).ListSubItems.Add 3, , Format(Ws.Cells(l, 5), "Currency")
.ListItems(1).ListSubItems.Add 3, , Ws.Cells(l, 4)
End With
Next
Me.txtsomapecas = Clear
Me.txtvalorkit = Clear
Me.txtsomapecas = Ws.Cells(1, 2)
Me.txtvalorkit = Format(Ws.Cells(1, 6), "Currency")
End Sub