Página 1 de 1

Criar Loop

Enviado: 02 Jan 2020 às 14:29
por Wascesar0412
Boa tarde Pessoal,

Estou aprendendo a suar o VBA, e estou com dificuldades de realizar um loop dentro de um listbox.

Na realidade preciso percorrer todo os dados dentro de um listbox e imprimir conforme por campo.

tenho no listbox os campos fornecedores e produtos.

Preciso imprimir a relação de cada produto vinculado ao seu fornecedor.

segue a rotina que utilizo

Private Sub CommandButton2_Click()
On Error Resume Next
Dim ListaFornecedores As New Collection, Linha
Dim I As Integer
Dim T As Integer
Dim XYZ() As String

TotalFor = cmbFornecedor.ListCount - 1
ReDim XYZ(TotalFor) As String

'// Coletando todos os Fornecedores
Dim Fornecedores() As String
ReDim Fornecedores(lstProdutos.ListCount - 1) As String


For T = 0 To cmbFornecedor.ListCount - 1
XYZ(T) = cmbFornecedor.List(T, 0)
For I = 0 To lstProdutos.ListCount - 1
If (XYZ(T) = lstProdutos.List(I, 2)) Then
Fornecedores(I) = XYZ(T)
End If
Next I
Next T

'//Eliminando os duplicados.
For Each Linha In Fornecedores
ListaFornecedores.Add Linha, Linha
Next
For L = 0 To ListaFornecedores.Count
ForNome = ListaFornecedores(L)

'// Salvando na Planilha Auxiliar
With Sheets("Auxiliar")
.Select
Range("B2").Value = txtCodCompra.Text
Range("B3").Value = ForNome
Range("D2").Value = Date
Range("A7").Select

For I = 0 To lstProdutos.ListCount - 1
If ForNome = lstProdutos.List(I, 2) Then
ActiveCell.Offset(I, 0).Value = lstProdutos.List(I, 0) ' Código
ActiveCell.Offset(I, 1).Value = lstProdutos.List(I, 1) ' Nome
ActiveCell.Offset(I, 2).Value = Format(lstProdutos.List(I, 3), "000") ' Quantidade
ActiveCell.Offset(I, 3).Value = Format(lstProdutos.List(I, 4), "###,##0.00") ' Valor únitario
ActiveCell.Offset(I, 4).Value = Format(lstProdutos.List(I, 5), "###,##0.00") ' Valor Total
Else
' Tenho que deletar as linhas e não limpar
ActiveCell.Offset(I, 0).Value = Empty
ActiveCell.Offset(I, 1).Value = Empty
ActiveCell.Offset(I, 2).Value = Empty
ActiveCell.Offset(I, 3).Value = Empty
ActiveCell.Offset(I, 4).Value = Empty
End If
Next I
End With

Call Imprimir

Next L

End Sub


Deste de já agradeço .