⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 main_rcyw_sell.frm

📁 医药进销存管理系统 对医药的购买销售和库存进行系统管理
💻 FRM
📖 第 1 页 / 共 3 页
字号:
      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 + -