Atualização de dado...
 
Notifications
Clear all

Atualização de dados - ListView

4 Posts
2 Usuários
0 Reactions
1,520 Visualizações
(@ueleodoro)
Posts: 133
Estimable Member
Topic starter
 

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

Ulisses Eleodoro dos Santos
---------------------------------------
Compartilha o conhecimento é a
forma mais valorosa na busca da
sabedoria.
---------------------------------------

 
Postado : 21/10/2013 3:57 pm
(@ueleodoro)
Posts: 133
Estimable Member
Topic starter
 

Esqueci de uma Módulo para colunas automáticas que peguei aqui no fórum.

'INICIO - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW
'TamanhoColAutomatico - 'Define os Tamanhos das colunas automaticamente
Public Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hWnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const LVM_FIRST = &H1000
Public Const LVM_SETCOLUMNWIDTH = (LVM_FIRST + 30)
Public Const LVSCW_AUTOSIZE = -1
Public Const LVSCW_AUTOSIZE_USEHEADER = -2
'FIM - REDIMENSIONAR AUTOMATICAMENTE COLUNAS DO LISTVIEW

Ulisses Eleodoro dos Santos
---------------------------------------
Compartilha o conhecimento é a
forma mais valorosa na busca da
sabedoria.
---------------------------------------

 
Postado : 21/10/2013 4:37 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Ueleodoro, sinceramente me deu um nó só de tentar entender, se possível prepare um modelo reduzido e compactado.

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 23/10/2013 10:58 am
(@ueleodoro)
Posts: 133
Estimable Member
Topic starter
 

Vou preparar sim. A situaçao agora já mudou bastante. Vou encerrar este post..e preparar a situação atual.

Ulisses Eleodoro dos Santos
---------------------------------------
Compartilha o conhecimento é a
forma mais valorosa na busca da
sabedoria.
---------------------------------------

 
Postado : 23/10/2013 3:15 pm