Maycon Cavalini

Bom dia,preciso de ajuda para modificar 3 códigos que foram feitos para Listview.Preciso que me ajudem a modefica-los para Listbox devido ao listview não ter suporte ao office 64bits.Espero que possam me ajudar,segue abaixo os códigos 1º codigo Private Sub carregar_DblClick() Dim Buscar As Long Buscar = CLng(lstvFiltro.SelectedItem.ListSubItems(1).Text) SqlOrçDet = "SELECT * FROM tbOrç_Detalhe WHERE Nro_Orçamento = " & Buscar SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & Buscar rsOrçDet.Close rsOrçGrad.Close rsOrçDet.Open SqlOrçDet, cn, adOpenKeyset, adLockOptimistic rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic With frmOrçamento .txtNome = rsOrçDet("Nome_Cli") If rsOrçDet("Acresc_Desc") = 1 Then Else End If With .lstvOrç .ListItems.Clear For i = 1 To rsOrçGrad.RecordCount On Error Resume Next .ListItems.Add 1, , Format(rsOrçGrad(1), "0") On Error Resume Next .ListItems(1).ListSubItems.Add 1, , rsOrçGrad(2) On Error Resume Next .ListItems(1).ListSubItems.Add 2, , Format(rsOrçGrad(3), "") On Error Resume Next .ListItems(1).ListSubItems.Add 3, , Format(rsOrçGrad(4), "") 'codigo On Error Resume Next .ListItems(1).ListSubItems.Add 4, , Format(rsOrçGrad(5), "") On Error Resume Next .ListItems(1).ListSubItems.Add 5, , Format(rsOrçGrad(6), "") On Error Resume Next .ListItems(1).ListSubItems.Add 6, , Format(rsOrçGrad(7), "") On Error Resume Next .ListItems(1).ListSubItems.Add 7, , Format(rsOrçGrad(8), "") On Error Resume Next .ListItems(1).ListSubItems(7).Bold = True On Error Resume Next rsOrçGrad.MoveNext Next i End With .CalcTotal .btnNovo.Enabled = True .btnGravar.Enabled = True .CommandButton2.Enabled = True .btnExcluir.Enabled = True NroOrç = rsOrçDet("Nro_Orçamento") End With Inc = False Buscar = CLng(lstvFiltro.SelectedItem.ListSubItems(1).Text) SqlOrçDet = "SELECT * FROM tbOrç_Detalhe WHERE Nro_Orçamento = " & Buscar SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & Buscar rsOrçDet.Close rsOrçGrad.Close rsOrçDet.Open SqlOrçDet, cn, adOpenKeyset, adLockOptimistic rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic With frmOrçamento .txtNome = rsOrçDet("Nome_Cli") If rsOrçDet("Acresc_Desc") = 1 Then Else End If With .ListView1 .ListItems.Clear For i = 1 To rsOrçGrad.RecordCount On Error Resume Next .ListItems.Add 1, , Format(rsOrçGrad(1), "0") 'Auxiliar On Error Resume Next .ListItems(1).ListSubItems.Add 1, , rsOrçGrad(3) 'Quantidade On Error Resume Next .ListItems(1).ListSubItems.Add 2, , Format(rsOrçGrad(5), "") On Error Resume Next rsOrçGrad.MoveNext Next i End With .CalcTotal .btnNovo.Enabled = True .btnGravar.Enabled = True NroOrç = rsOrçDet("Nro_Orçamento") End With Inc = False Unload Me End Sub 2º Código Sub carregar() With Me.lstvFiltro .ListItems.Clear If rsOrçDet.RecordCount > 0 Then rsOrçDet.MoveFirst For i = 1 To rsOrçDet.RecordCount .ListItems.Add 1, , Format(rsOrçDet("Data"), "dd/mm/yyyy") .ListItems(1).ListSubItems.Add 1, , Format(rsOrçDet("Nro_Orçamento"), "0,00") .ListItems(1).ListSubItems.Add 2, , rsOrçDet("Nome_Cli") .ListItems(1).ListSubItems.Add 3, , Format(rsOrçDet("Total_Liquido"), "currency") rsOrçDet.MoveNext Next i End If End With Me.lblReg.Caption = " Registros Encontrados: " & Format(rsOrçDet.RecordCount, "0,00") End Sub 3º Código Private Sub btnGravar_Click() Dim i As Integer If Me.txtNome = Empty Then MsgBox "Digite um nome para esse Detalhamento.", vbExclamation, "Atenção" Me.txtNome.SetFocus Exit Sub End If If Not Me.lstvOrç.ListItems.Count > 0 Then MsgBox "É necessário incluir pelo menos um Item na Lista" & Chr(13) _ & ".", vbExclamation, "" Me.txtPreTotal.SetFocus Exit Sub End If If Inc = True Then rsOrçDet.AddNew Else rsOrçGrad.Close SqlOrçGrad = "DELETE FROM tbOrçamento_Grade WHERE Nro_Orçamento = " & NroOrç 'Apaga os registros antigos rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic 'pra incluir os dados atualizados SqlOrçGrad = "SELECT * FROM tbOrçamento_Grade" rsOrçGrad.Open SqlOrçGrad, cn, adOpenKeyset, adLockOptimistic End If rsOrçDet(1) = Date rsOrçDet(2) = Me.txtNome rsOrçDet(3) = 1 rsOrçDet(3) = 3 rsOrçDet(4) = 0 rsOrçDet(5) = 0 rsOrçDet.Update For i = 1 To Me.lstvOrç.ListItems.Count With Me.lstvOrç rsOrçGrad.AddNew rsOrçGrad(0) = NroOrç rsOrçGrad(1) = .ListItems(1) rsOrçGrad(2) = .ListItems(i).ListSubItems(1) rsOrçGrad(3) = CDbl(.ListItems(i).ListSubItems(2)) rsOrçGrad(4) = CDbl(.ListItems(i).ListSubItems(3)) On Error Resume Next rsOrçGrad(5) = CDbl(.ListItems(i).ListSubItems(4)) rsOrçGrad.Update End With Next i If Inc = True Then rsNro.AddNew rsNro(0) = NroOrç rsNro.Update End If Inc = False LimpaControles rsNro.MoveLast NroOrç = rsNro(0).Value + 1 iCancel = 0 End Sub Aguardo Retono.