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
Postado : 15/05/2016 9:12 pm