Sandra Fabilicio

pessoal depois de muito tentar 48 hs seguidas fazendo alterações aqui e ali consegui resolver da seguinte forma Sub busca_pedidos() 'Adiciona os dados a listview historico Dim linha As Integer Dim xTot As Double Dim CodCli As Integer Dim Li Dim quantidade As Integer Dim Dias As Integer Dim Estoquepaciente As Integer Dim Datahoje As Date Plan4.Activate Datahoje = Date Datahoje = Format(Datahoje, "MM/DD/YYYY") >>>>>>>>>>>>>>>>alterei aqui CodCli = txt_id linha = 2 list_historico.ListItems.Clear Do Until Cells(linha, 1) = "" If Cells(linha, 2) = CodCli Then Set Li = list_historico.ListItems.Add(Text:=Cells(linha, 1).Value) 'ID pedido Li.ListSubItems.Add Text:=Cells(linha, 6).Value 'MEDICAÇÃO Li.ListSubItems.Add Text:=Cells(linha, 13) 'CID Cells(linha, 9) = Format(Cells(linha, 9).Value, "MM/DD/YYYY")>>>>>>>>>>>>>>>>alterei aqui Li.ListSubItems.Add Text:=Cells(linha, 9) 'DATA SAÍDA Li.ListSubItems.Add Text:=Cells(linha, 8).Value 'QUANT Li.ListSubItems.Add Text:=Cells(linha, 16).Value 'Qnt/Dia Dias = Datahoje - Cells(linha, 9) If Dias < 0 Then Dias = 0 End If quantidade = Cells(linha, 8).Value / Cells(linha, 16).Value Estoquepaciente = quantidade - Dias Li.ListSubItems.Add Text:=Estoquepaciente & " Dias" 'EST. PACIENTE Li.ListSubItems.Add Text:=Cells(linha, 12) ' pendencia End If linha = linha + 1 Loop Set Li = Nothing End Sub

por mais que eu tente não tem como fazer para o valor entrar na célula como numero, só entra como texto, ele só fica como texto se eu for lá e clicar na célula e o cursor ficar piscando dentro dela, dai é só clicar fora e pronto ele fica "automático" como número, mas não posso fazer isso o tempo todo tá difícil.... estou criando um programa que vai dar entrada em medicamentos em uma farmácia do sus, trabalho lá é só para facilitar...., dai preciso saber quantos dias os pacientes ainda tem de remédio para eu poder entregar o próximo... vou postar os códigos a seguir.... primeiro as linhas do listview list_pedidos.Gridlines = True list_pedidos.View = lvwReport list_pedidos.FullRowSelect = True 'Inclui algumas colunas list_pedidos.ColumnHeaders.Add Text:="COD MEDIC", Width:=40 list_pedidos.ColumnHeaders.Add Text:="ID PED", Width:=0 list_pedidos.ColumnHeaders.Add Text:="COD PAC.", Width:=0 list_pedidos.ColumnHeaders.Add Text:="NOME PACIENTE", Width:=0 list_pedidos.ColumnHeaders.Add Text:="TIPO", Width:=60 list_pedidos.ColumnHeaders.Add Text:="MEDICAÇÃO", Width:=133 list_pedidos.ColumnHeaders.Add Text:="CID", Width:=50 list_pedidos.ColumnHeaders.Add Text:="Qnt/Dia", Width:=40 list_pedidos.ColumnHeaders.Add Text:="SAÍDA", Width:=50 list_pedidos.ColumnHeaders.Add Text:="DATA SAIDA.", Width:=0, Alignment:=2 list_pedidos.ColumnHeaders.Add Text:="STATUS", Width:=70 list_pedidos.ColumnHeaders.Add Text:="ESTOQUE ATUAL", Width:=75 depois o código que preenche o mesmo Private Sub Btn_incluir_item_Click() Dim linha As Integer Dim xTot As Double Dim Medicamento As String Dim vDat As Date Dim Li Plan3.Activate Medicamento = txt_produto1 vDat = Date linha = 2 Do Until Cells(linha, 1) = "" If Cells(linha, 2) = Medicamento Then Set Li = list_pedidos.ListItems.Add(Text:=Cells(linha, 1).Value) 'cod medic Li.ListSubItems.Add Text:=txt_id_pedido 'cod id pedido Li.ListSubItems.Add Text:=txt_id.Value 'cod pac Li.ListSubItems.Add Text:=TxtClienteP2.Text 'nome paciente Li.ListSubItems.Add Text:=txt_medida.Text 'tipo Li.ListSubItems.Add Text:=txt_produto1.Text 'MEDICAÇÃO Li.ListSubItems.Add Text:=TextBox1.Text 'cid Li.ListSubItems.Add Text:=TextBox2.Value 'Qnt/Dia Li.ListSubItems.Add Text:=txt_qnd.Value 'SAÍDA Li.ListSubItems.Add Text:=vDat 'data saida Li.ListSubItems.Add Text:=Txt_pendencia Li.ListSubItems.Add Text:=Cells(linha, 5) - (txt_qnd.Value) Txt_buscar_medic = "" txt_medida = "" txt_produto1 = "" txt_qnd = "" TextBox1 = "" Txt_pendencia = "" lbl_info = "" Exit Sub End If linha = linha + 1 Loop Set Li = Nothing e dai o código que faz o lançamento no estoque e no histórico do paciente Private Sub btn_confirmar_Click() Dim xLin As Long Dim xPro As Integer Dim xCod As String Dim xQTD As String Dim xTip As Integer Dim linha As Long Dim MaxProd As Integer Dim Resp MaxProd = 1000 Resp = MsgBox("Deseja realmente FECHAR este Pedido?", vbYesNo + vbDefaultButton1) If Resp = vbNo Then Resp = MsgBox("Deseja CANCELAR este Pedido?", vbYesNo + vbDefaultButton2) If Resp = vbYes Then MsgBox "Venda cancelada pelo usuário!", vbInformation Exit Sub End If End If Plan3.Activate For xPro = 1 To Me.list_pedidos.ListItems.Count xCod = UCase$(Trim(Me.list_pedidos.ListItems.Item(xPro))) xQTD = CInt(Me.list_pedidos.ListItems.Item(xPro).SubItems(8)) For xLin = 2 To MaxProd If UCase$(Trim(Cells(xLin, 1))) = xCod Then Cells(xLin, 5) = Cells(xLin, 5) - (xQTD) Exit For End If Next Next Plan4.Activate linha = Range("A" & Rows.Count).End(xlUp).Row + 1 For i = 1 To list_pedidos.ListItems.Count On Error Resume Next Cells(linha, 1) = list_pedidos.ListItems.Item(i).SubItems(1) ' cod oper Cells(linha, 2) = list_pedidos.ListItems.Item(i).SubItems(2) 'cod pac Cells(linha, 3) = list_pedidos.ListItems.Item(i) ' cod medic Cells(linha, 4) = list_pedidos.ListItems.Item(i).SubItems(3) 'nome paci Cells(linha, 5) = list_pedidos.ListItems.Item(i).SubItems(4) 'tipo medic Cells(linha, 6) = list_pedidos.ListItems.Item(i).SubItems(5) 'nome medic Cells(linha, 13) = list_pedidos.ListItems.Item(i).SubItems(6) 'CID Cells(linha, 16) = list_pedidos.ListItems.Item(i).SubItems(7) ' Qnt/dia Cells(linha, 8) = list_pedidos.ListItems.Item(i).SubItems(8) ' saida Cells(linha, 9) = list_pedidos.ListItems.Item(i).SubItems(9) ' data saida Cells(linha, 12) = list_pedidos.ListItems.Item(i).SubItems(10) 'pendencia Cells(linha, 15) = list_pedidos.ListItems.Item(i).SubItems(11) 'estoque atual Next list_pedidos.ListItems.Clear End Sub mas o meu GRANDE PROBLEMA est[a aqui neste abaixo: Sub busca_pedidos() 'Adiciona os dados a listview historico Dim linha As Integer Dim xTot As Double Dim CodCli As Integer Dim Li Dim quantidade As Integer Dim Dias As Integer Dim Estoquepaciente As Integer Dim Datahoje As Date Plan4.Activate Datahoje = Date CodCli = txt_id linha = 2 list_historico.ListItems.Clear Do Until Cells(linha, 1) = "" If Cells(linha, 2) = CodCli Then Set Li = list_historico.ListItems.Add(Text:=Cells(linha, 1).Value) 'ID pedido Li.ListSubItems.Add Text:=Cells(linha, 6).Value 'MEDICAÇÃO Li.ListSubItems.Add Text:=Cells(linha, 13) 'CID Li.ListSubItems.Add Text:=Cells(linha, 9) 'DATA SAÍDA Li.ListSubItems.Add Text:=Cells(linha, 8).Value 'QUANT Li.ListSubItems.Add Text:=Cells(linha, 16).Value 'Qnt/Dia Dias = Datahoje - Cells(linha, 9)--------------------------------------------->>>>>>>>>>>>>>>> aqui ele deveria tirar qntos dias ainda restam em remedios mas da erro porque a data esta registrada acima como texto..... If Dias < 0 Then Dias = 0 End If quantidade = Cells(linha, 8).Value / Cells(linha, 16).Value Estoquepaciente = quantidade - Dias Li.ListSubItems.Add Text:=Estoquepaciente & " Dias" 'EST. PACIENTE Li.ListSubItems.Add Text:=Cells(linha, 12) ' pendencia End If linha = linha + 1 Loop Set Li = Nothing