📄 main_rcyw_sell.frm
字号:
msgSell.TextMatrix(msgSell.Row, 4) = Trim(adoStock.Recordset.Fields("规格"))
msgSell.TextMatrix(msgSell.Row, 5) = Trim(adoStock.Recordset.Fields("产地"))
msgSell.TextMatrix(msgSell.Row, 6) = Trim(adoStock.Recordset.Fields("单位"))
msgSell.TextMatrix(msgSell.Row, 7) = adoStock.Recordset.Fields("零售价")
'赋值给txtInput
txtInput.Text = msgSell.Text
txtInput.SetFocus
msgSell.Col = 7
dgdStock.Visible = False
Else
MsgBox ("无数据选择!")
dgdStock.Visible = False
txtInput.SetFocus
End If
End If
txtInput.SetFocus
End If
If KeyCode = vbKeyEscape Then '按ESC键dgdStock不可见
dgdStock.Visible = False
txtInput.SetFocus 'txtInput获得焦点
End If
End Sub
Private Sub dblClient_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then
ClientNumber = dblClient.BoundText
txtClient.Text = dblClient.Text
dblClient.Visible = False
txtClient.SetFocus
End If
End Sub
Private Sub msgSell_Click() '单击msgSell表,txtInput表可见并获得焦点
If msgSell.Row > 1 And msgSell.TextMatrix(msgSell.Row - 1, 7) <> "" Then
txtInput.Visible = True
txtInput.SetFocus
End If
If msgSell.Row = 1 Then
txtInput.Visible = True
txtInput.SetFocus
End If
End Sub
Private Sub msgSell_entercell() '确定txtInput在msgSell表中的位置
Dim X, y, P As String
If msgSell.CellWidth <= 0 Or msgSell.CellHeight <= 0 Then Exit Sub
X = msgSell.TextMatrix(msgSell.FixedRows, msgSell.Col)
y = msgSell.TextMatrix(msgSell.Row, 0)
If y <> "" Then
If msgSell.Col - msgSell.LeftCol <= 3 Then
msgSell.LeftCol = msgSell.LeftCol + 1
End If
If msgSell.CellWidth > 0 And msgSell.CellHeight > 0 Then
txtInput.Width = msgSell.CellWidth
txtInput.Height = msgSell.CellHeight
txtInput.Left = msgSell.CellLeft + msgSell.Left
txtInput.Top = msgSell.CellTop + msgSell.Top
End If
X = msgSell.TextMatrix(msgSell.FixedRows, msgSell.Col)
y = msgSell.TextMatrix(msgSell.Row, 0)
P = msgSell.TextMatrix(msgSell.Row, msgSell.Col)
txtInput.Text = msgSell.Text
End If
End Sub
Private Sub msgSell_RowColChange()
'格式化msgSell表的第7列、第8列、第9列、第11列
For i = 1 To 101
If msgSell.TextMatrix(i, 1) <> "" Then
msgSell.TextMatrix(msgSell.Row, 7) = Format(msgSell.TextMatrix(msgSell.Row, 7), "#0.00")
msgSell.TextMatrix(msgSell.Row, 9) = Val(msgSell.TextMatrix(msgSell.Row, 7)) * Val(msgSell.TextMatrix(msgSell.Row, 8))
msgSell.TextMatrix(msgSell.Row, 9) = Format(msgSell.TextMatrix(msgSell.Row, 9), "#0.00")
End If
Next i
End Sub
Private Sub txtNet_Change() '求未付金额
lblNotCharge.Caption = Format((Val(lblCharge) - Val(txtNet)), "0.00")
End Sub
Private Sub txtNet_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then cmdSave.SetFocus
End Sub
Private Sub txtCess_Change() '求应付金额
lblCharge = Format((Val(lblSum) * (Val(txtAgio.Text) / 10)) + (Val(lblCharge) * (Val(txtCess.Text) / 100)), "0.00")
End Sub
Private Sub txtCess_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then cboPayee.SetFocus
End Sub
Private Sub txtAgio_Change() '求应付金额
lblCharge = Format((Val(lblSum) * (Val(txtAgio.Text) / 10)) + (Val(lblCharge) * (Val(txtCess.Text) / 100)), "0.00")
End Sub
Private Sub lblSum_Change() '求应付金额
lblCharge = Format((Val(lblSum) * (Val(txtAgio.Text) / 10)) + (Val(lblCharge) * (Val(txtCess.Text) / 100)), "0.00")
lblNotCharge.Caption = Format((Val(lblCharge) - Val(txtNet)), "0.00")
End Sub
Private Sub txtAgio_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then txtCess.SetFocus
End Sub
Private Sub cboPayee_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyReturn Then txtNet.SetFocus
End Sub
Private Sub txtInput_KeyDown(KeyCode As Integer, Shift As Integer)
With msgSell
If KeyCode = vbKeyReturn Then
dgdStock.Visible = False
If .Col = 1 Then
If adoStock.Recordset.RecordCount > 0 Then
'赋值给msgSell表格
.TextMatrix(.Row, 1) = adoStock.Recordset.Fields("药品名称")
.TextMatrix(.Row, 2) = adoStock.Recordset.Fields("药品编号")
.TextMatrix(.Row, 3) = adoStock.Recordset.Fields("批号")
.TextMatrix(.Row, 4) = adoStock.Recordset.Fields("规格")
.TextMatrix(.Row, 5) = adoStock.Recordset.Fields("产地")
.TextMatrix(.Row, 6) = adoStock.Recordset.Fields("单位")
.TextMatrix(.Row, 7) = adoStock.Recordset.Fields("零售价")
txtInput.SetFocus
txtInput.Text = .Text
dgdStock.Visible = False
.Col = 6
End If
End If
If .Col = 9 Then
.Row = .Row + 1
.Col = 1
Else
If .Col + 1 <= .Cols - 1 Then
.Col = .Col + 1
Else
If .Row + 1 <= .Rows - 1 Then
.Row = .Row + 1
.Col = 1
End If
End If
End If
End If
If KeyCode = vbKeyUp Then
If .Row > 1 Then .Row = .Row - 1
End If
If KeyCode = vbKeyDown Then
If .Row < 99 Then .Row = .Row + 1
End If
If KeyCode = vbKeyLeft Then
If txtInput.Text <> "" Then
txtInput.SelStart = 0
txtInput.SelLength = Len(txtInput.Text)
End If
If .Col - 9 <= .Cols + 1 Then
.Col = .Col - 1
If .Col = 0 Then .Col = 1
Else
If .Row + 1 <= .Row - 1 Then
.Row = .Row + 1
.Col = 1
End If
End If
End If
If KeyCode = vbKeyRight Then
If txtInput.Text <> "" Then
txtInput.SelStart = 0
txtInput.SelLength = Len(txtInput.Text)
End If
If .Col + 1 <= .Cols - 1 Then
.Col = .Col + 1
Else
If .Row + 1 <= .Rows - 1 Then
.Row = .Row + 1
.Col = 1
End If
End If
End If
If KeyCode = vbKeyPageDown Then
If .Col = 1 Then
adoStock.RecordSource = "select * from tb_stock order by 药品编号,有效期至"
adoStock.Refresh
dgdStock.Visible = True
dgdStock.SetFocus
End If
End If
End With
End Sub
Private Sub txtInput_Change()
msgSell.Text = txtInput.Text '将txtInput的值赋给msgSell
If msgSell.Col = 1 Then
If txtInput.Text = "" Then
dgdStock.Visible = False
Else
'筛选药品名称或简称符合txtInput的记录
adoStock.RecordSource = "select * from tb_medicine where 药品名称 like '" + txtInput.Text + "'+ '%'or 拼音码 like '" + txtInput.Text + "'+'%'"
adoStock.Refresh
If adoStock.Recordset.RecordCount > 0 Then
dgdStock.Visible = True
txtInput.SetFocus
End If
End If
End If
If msgSell.Col = 3 Then
If msgSell.TextMatrix(msgSell.Row, 1) = "" Then
MsgBox "无药品名称,请重新输入!", , Me.Caption
msgSell.Col = 1
End If
End If
If msgSell.Col = 7 Or 8 Then
'求金额
msgSell.TextMatrix(msgSell.Row, 9) = Val(msgSell.TextMatrix(msgSell.Row, 7)) * Val(msgSell.TextMatrix(msgSell.Row, 8))
End If
Dim a, b, c As Single
For i = 1 To 101
If msgSell.TextMatrix(i, 1) <> "" And msgSell.TextMatrix(i, 8) <> "" Then
lblBreed = i '品种数
a = Val(msgSell.TextMatrix(i, 9)) + a '求合计金额
b = Val(msgSell.TextMatrix(i, 8)) + b '求合计数量
End If
Next i
lblCount = b
lblSum = Format(a, "0.00") '格式化合计金额
End Sub
Private Sub cmdRegister_Click()
'文本框的大小和位置等于msgSell中网格的大小和位置
txtInput.Width = msgSell.CellWidth
txtInput.Height = msgSell.CellHeight
txtInput.Left = msgSell.CellLeft + msgSell.Left
txtInput.Top = msgSell.CellTop + msgSell.Top
msgSell.Enabled = True
Dim tmpNote As Integer
rs1.Open "select * from tb_sell_detailed order by 销售单据号", cnn, adOpenKeyset, adLockOptimistic
'创建销售单据号
If rs1.RecordCount > 0 Then
If Not rs1.EOF Then rs1.MoveLast
If rs1.Fields("销售单据号") <> "" Then
tmpNote = Val(Right(Trim(rs1.Fields("销售单据号")), 4)) + 1
txtNote.Text = Date & "xs" & Format(tmpNote, "0000")
End If
Else
txtNote.Text = Date & "xs" & "0001"
End If
rs1.Close
'清空msgSell网格中的内容
For i = 1 To 100
For j = 1 To 9
msgSell.TextMatrix(i, j) = ""
Next j
Next i
'清空文本框内容
txtClient.Text = ""
txtInput.Text = ""
txtHandle.Text = ""
lblBreed.Caption = "0"
lblCount = "0"
lblSum = "0"
txtNet = "0"
lblNotCharge.Caption = "0"
'设置控件可用或不可用状态
txtClient.Enabled = True
txtClient.SetFocus
txtNet.Enabled = True
cmdSave.Enabled = True
cmdCancel.Enabled = True
cmdRegister.Enabled = False
txtInput.Enabled = True
txtNet.Enabled = True
End Sub
Private Sub cmdSave_Click()
For i = 1 To 100
If msgSell.TextMatrix(i, 1) <> "" And msgSell.TextMatrix(i, 8) <> "" Then
rs1.Open "select * from tb_sell_detailed", cnn, adOpenKeyset, adLockOptimistic
'添加新记录到"tb_sell_detailed"表中
rs1.AddNew
rs1.Fields("药品名称") = msgSell.TextMatrix(i, 1)
rs1.Fields("药品编号") = Val(msgSell.TextMatrix(i, 2))
rs1.Fields("批号") = msgSell.TextMatrix(i, 3)
rs1.Fields("规格") = msgSell.TextMatrix(i, 4)
rs1.Fields("产地") = msgSell.TextMatrix(i, 5)
rs1.Fields("单位") = msgSell.TextMatrix(i, 6)
rs1.Fields("零售价") = Val(msgSell.TextMatrix(i, 7))
rs1.Fields("数量") = Val(msgSell.TextMatrix(i, 8))
rs1.Fields("金额") = Val(msgSell.TextMatrix(i, 9))
rs1.Fields("客户编号") = ClientNumber
rs1.Fields("客户名称") = txtClient.Text
rs1.Fields("销售单据号") = txtNote.Text
rs1.Update
rs1.Close
Dim rs3 As New ADODB.Recordset
rs3.Open "select * from tb_stock where 药品编号='" & msgSell.TextMatrix(i, 2) & "'and 批号= '" & msgSell.TextMatrix(i, 3) & "'", cnn, adOpenKeyset, adLockOptimistic
'判断是否有记录
If rs3.RecordCount > 0 Then
If rs3.Fields("药品名称") <> "" Then
'有记录,更新库存数量、库存金额
rs3.Fields("库存数量") = rs3.Fields("库存数量") - Trim(Val(msgSell.TextMatrix(i, 8)))
rs3.Update
End If
Else
MsgBox "库存无此药品!"
End If
rs3.Close
Set rs3 = Nothing
Dim rs4 As New ADODB.Recordset
'添加记录到tb_Client_Arrearage表中
rs4.Open "select * from tb_Client_Arrearage", cnn, adOpenKeyset, adLockOptimistic
If rs4.EOF = False Then rs4.MoveLast
rs4.AddNew
If txtDate.Text <> "" Then rs4.Fields("日期") = txtDate.Text
rs4.Fields("时间") = Time
If txtNote.Text <> "" Then rs4.Fields("销售单据号") = txtNote.Text
If msgSell.TextMatrix(i, 8) <> "" Then rs4.Fields("数量") = msgSell.TextMatrix(i, 8)
If msgSell.TextMatrix(i, 9) <> "" Then rs4.Fields("金额小计") = msgSell.TextMatrix(i, 9)
If msgSell.TextMatrix(i, 7) <> "" Then rs4.Fields("单价") = msgSell.TextMatrix(i, 7)
If msgSell.TextMatrix(i, 6) <> "" Then rs4.Fields("单位") = msgSell.TextMatrix(i, 6)
If txtClient.Text <> "" Then rs4.Fields("客户名称") = txtClient.Text
rs4.Fields("客户编号") = ClientNumber
If txtClient.Text <> "" Then rs4.Fields("摘要") = "销售:【" & txtClient.Text & "】的" & "【" & msgSell.TextMatrix(i, 1) & "," & msgSell.TextMatrix(i, 3) & "】等"
rs4.Update
rs4.Close
Set rs4 = Nothing
End If
Next i
Dim rs2 As New ADODB.Recordset
rs2.Open "select * from tb_sell_main", cnn, adOpenKeyset, adLockOptimistic
rs2.AddNew
rs2.Fields("销售单据号") = txtNote.Text
rs2.Fields("品种数") = lblBreed
rs2.Fields("数量") = lblCount
rs2.Fields("金额") = lblSum
rs2.Fields("折扣") = txtAgio.Text
rs2.Fields("税率") = Val(txtCess.Text) / 100
rs2.Fields("应收") = Val(lblCharge)
rs2.Fields("实收") = Val(txtNet)
rs2.Fields("未收") = Val(lblNotCharge.Caption)
rs2.Fields("客户编号") = ClientNumber
rs2.Fields("日期") = txtDate.Text
rs2.Fields("收款方式") = cboPayee
rs2.Fields("经手人") = txtHandle
If Val(lblNotCharge.Caption) <= 0 Then rs2.Fields("是否结清") = 1 Else rs2.Fields("是否结清") = 0
rs2.Update
rs2.Close
Set rs2 = Nothing
adoClientArrearage.RecordSource = "select * from tb_Client_Arrearage where 客户名称 = '" + txtClient.Text + "'"
adoClientArrearage.Refresh
With adoClientArrearage.Recordset
If .RecordCount > 0 Then
If .EOF = False Then .MoveLast
.Fields("欠款记账") = Val(lblNotCharge.Caption)
.Fields("累计余额") = Val(txtClientBalance.Text) + Val(lblNotCharge.Caption)
.Update
End If
End With
txtInput.Visible = False
dgdStock.Visible = False
dblClient.Visible = False
msgSell.Enabled = False
cmdRegister.Enabled = True
cmdSave.Enabled = False
End Sub
Private Sub cmdCancel_Click() '取消操作
For i = 1 To 101
For j = 1 To 9
msgSell.TextMatrix(i, j) = ""
Next j
Next i
msgSell.Enabled = False
txtInput.Visible = False
lblBreed = "0"
lblSum.Caption = "0"
lblCount.Caption = "0"
txtNet = "0"
lblNotCharge.Caption = "0"
txtClient.Text = ""
cmdRegister.Enabled = True
cmdRegister.SetFocus
txtNet.Enabled = False
End Sub
Private Sub cmdQuit_Click()
Unload Me
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -