form1.frm

简易销售管理系统 全套代码和ps文件都在。界面可以自己调试

End If
Set s3 = cnn.Execute("select * from 商品型号 where 商品类型='" & Grid2.Cell(Row, 1).Text & "' and 商品名称='" & Grid2.Cell(Row, 2).Text & "'")
Grid2.ComboBox(3).Clear
Do While s3.EOF = False
Grid2.ComboBox(3).AddItem s3.Fields(2)
s3.MoveNext
Loop
End Sub

Private Sub Grid2_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 Then
If gridsave = True Then
  tjsave.Enabled = True
Else
  tjsave.Enabled = False
End If
If gridedit = True Then
  tjedit.Enabled = True
Else
  tjedit.Enabled = False
End If
If griddelete = True Then
  tjdelete.Enabled = True
Else
  tjdelete.Enabled = False
End If
PopupMenu ZT
End If
End Sub

Private Sub Grid2_RowColChange(ByVal Row As Long, ByVal Col As Long)
On Error GoTo tkFinish
hang2 = Row
For i = 1 To Grid2.Rows - 1
If Grid2.Cell(i, 4).Text <> "" And Grid2.Cell(i, 6).Text <> "" And Grid2.Cell(i, 1).Text <> "" Then
Grid2.Cell(i, 7).Text = Grid2.Cell(i, 4).Text * Grid2.Cell(i, 6).Text
End If
Next
Dim znum As Double
For i = 1 To Grid2.Rows - 1
 If Grid2.Cell(i, 7).Text <> "" And Grid2.Cell(i, 1).Text <> "" Then
 znum = znum + Val(Grid2.Cell(i, 7).Text)
 End If
Next
Grid3.Cell(1, 5).Text = znum
Exit Sub
tkFinish:
MsgBox Err.Description
End Sub

Private Sub Grid2_Validate(Cancel As Boolean)
    Dim nActiveRow As Long, nActiveCol As Long
    Const VK_TAB = 9

    If GetKeyState(VK_TAB) < 0 Then
        nActiveRow = Grid1.ActiveCell.Row
        nActiveCol = Grid1.ActiveCell.Col
        If nActiveCol < Grid1.Cols - 1 Then
            Grid1.Range(nActiveRow, nActiveCol + 1, _
                        nActiveRow, nActiveCol + 1).Selected
        End If
        Cancel = True
    End If
End Sub

Private Sub Image1_Click()
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hwnd = Form2.hwnd
fo2.Alpha = 85 / 100 * 255
duixiang = 1
Load Form2
Form2.Show 1
End Sub

Private Sub Image2_Click(Index As Integer)
Dim fo2 As CTranslucentForm
Set fo2 = New CTranslucentForm
fo2.hwnd = Form2.hwnd
fo2.Alpha = 85 / 100 * 255
duixiang = 2
Load Form2
Form2.Show 1
End Sub

Private Sub Image3_Click(Index As Integer)
If Frame7.Visible = True Then
Frame7.Visible = False
Exit Sub
End If
Frame7.Visible = True
Frame7.BackColor = RGB(84, 201, 134)
Text4.BackColor = Frame7.BackColor
Text4.SetFocus
XPButton11.Default = True
End Sub

Private Sub renovate_Click()
Call asPopup1_Click(False)
End Sub

Private Sub returncg_Click()
Grid1.Visible = True
Grid2.Visible = False
End Sub

Private Sub savestudent_Click()
Call XPButton5_Click
End Sub

Private Sub tjdelete_Click()
Call XPButton6_Click
End Sub

Private Sub tjedit_Click()
Call XPButton4_Click
End Sub

Private Sub tjsave_Click()
Call XPButton5_Click
End Sub

Private Sub XPButton1_Click()
If numpage > 1 Then
numpage = numpage - 1
qy1.AbsolutePage = numpage
Grid1.Rows = 1
Grid1.Rows = 11
For i = 1 To 10 '设定读取行
 For j = 1 To jnumber - 2 '设定读取列
 If qy1.Fields(j) = Null Then '空值的处理
 Grid1.Cell(i, j).Text = ""
 Else
 Grid1.Cell(i, j).Text = qy1.Fields(j)
 End If
 Next
 qy1.MoveNext  '读取上一记录
 Next
End If
Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
End Sub

Private Sub XPButton11_Click()
If Text4.Text = "" Then
Exit Sub
End If
Set qy3 = cnn.Execute("select * from 商品单位 where 商品单位='" & Text4.Text & "'")
If qy3.EOF = True Then
Set qy3 = cnn.Execute("insert into 商品单位 values('" & Text4.Text & "')")
MsgBox "添加商品单位成功!", vbInformation, "添加成功"
Else
MsgBox "添加重复!", vbInformation, "添加错误"
End If
End Sub

Private Sub XPButton12_Click()
Frame7.Visible = False
End Sub

Private Sub XPButton13_Click()
If numpage > 1 Then
numpage = 1
qy1.AbsolutePage = numpage
Grid1.Rows = 1
Grid1.Rows = 11
For i = 1 To 10 '设定读取行
 For j = 1 To jnumber - 2 '设定读取列
 If qy1.Fields(j) = Null Then '空值的处理
 Grid1.Cell(i, j).Text = ""
 Else
 Grid1.Cell(i, j).Text = qy1.Fields(j)
 End If
 Next
 qy1.MoveNext  '读取上一记录
 Next
End If
Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
End Sub

Private Sub XPButton14_Click()
If numpage < nnum Then
numpage = nnum
qy1.AbsolutePage = numpage
Grid1.Rows = 1
Grid1.Rows = 11
For i = 1 To 10 '设定读取行
 For j = 1 To jnumber - 2 '设定读取列
 If qy1.EOF = True Then
  Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
 Exit Sub
 End If
 If qy1.Fields(j) = Null Then '空值的处理
 Grid1.Cell(i, j).Text = ""
 Else
 Grid1.Cell(i, j).Text = qy1.Fields(j)
 End If
 Next
 If qy1.EOF = False Then
 qy1.MoveNext  '读取下一记录
 Else
 Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
 Exit Sub
 End If
 Next
Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
End If
End Sub

Private Sub XPButton2_Click()
If numpage < nnum Then
numpage = numpage + 1
qy1.AbsolutePage = numpage
Grid1.Rows = 1
Grid1.Rows = 11
For i = 1 To 10 '设定读取行
 For j = 1 To jnumber - 2 '设定读取列
 If qy1.EOF = True Then
  Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
 Exit Sub
 End If
 If qy1.Fields(j) = Null Then '空值的处理
 Grid1.Cell(i, j).Text = ""
 Else
 Grid1.Cell(i, j).Text = qy1.Fields(j)
 End If
 Next
 If qy1.EOF = False Then
 qy1.MoveNext  '读取下一记录
 Else
 Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
 Exit Sub
 End If
 Next
Label1.Caption = "共" & nnum & "页 第" & numpage & "页"
End If
End Sub

Private Sub XPButton3_Click()
XPFrame2.Visible = False
End Sub

Private Sub XPButton4_Click()
On Error GoTo tkFinish
If gridedit = False Then
MsgBox "当前修改操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
Dim delok As String
delok = MsgBox("此操作会修改单号为" & Grid1.Cell(hang1, 1).Text & "数据中的销售记录内容，是否确定？？", vbQuestion + vbOKCancel, "提示")
If delok = vbOK Then
hang2 = 1
 Do While hang2 < Grid2.Rows
 If Grid2.Cell(hang2, 1).Text = "" Then
 MsgBox "己完成修改操作!", , "提示"
 Exit Sub
 End If
  sql = "update 销售记录 set "
            For j = 1 To Grid2.Cols - 2
            sql = sql & qy1save.Fields(j - 1).Name & "='" & Grid2.Cell(hang2, j).Text & "',"
            Next
  sql = sql & qy1save.Fields(j - 1).Name & "='" & Grid2.Cell(hang2, j).Text & "' where 批号='" & Grid1.Cell(hang1, 1).Text & "' and 内部编号='" & hang2 & "'"
  Set qy2 = cnn.Execute(sql) '用qy2更新数据集,这样可实现批量更新
  hang2 = hang2 + 1
 Loop
 '---------------------
 Dim znum As Double '计算总金额
 For i = 1 To Grid2.Rows - 1
 If Grid2.Cell(i, 6).Text <> "" And Grid2.Cell(i, 1).Text <> "" Then
 znum = znum + Val(Grid2.Cell(i, 6).Text)
 End If
 Next
 '----------------------
 sql = "update 销售单据 set 总金额=" & znum & " where 批号='" & Grid1.Cell(hang1, 1).Text & "'"
 Set qy2 = cnn.Execute(sql) '更正总金额数目
 MsgBox "己完成修改操作!", , "提示"
 
 End If
 Exit Sub
tkFinish:
MsgBox Err.Description
End Sub

Private Sub XPButton5_Click()
On Error GoTo tkFinish
If gridsave = False Then
 MsgBox msgerror, vbInformation, "提示"
 Exit Sub
 End If
  If Grid3.Cell(1, 2).Text = "" Then
  MsgBox "单位不可为空", vbInformation, "提示"
  Grid3.Cell(1, 2).SetFocus
  Exit Sub
  End If
  For i = 1 To Grid2.Rows - 1
    If Grid2.Cell(i, 1).Text = "" Then
     If i = 1 Then
     MsgBox "无下属资料，取消保存!"
     Exit Sub
     End If
    Exit For
    End If
      jsql = "insert into 销售记录 values('"
            For j = 1 To 9
            jsql = jsql & Grid2.Cell(i, j).Text & "','"
           Next
     jsql = jsql & Grid3.Cell(1, 4).Text & "','" & i & "')"
     Set qy1save = cnn.Execute(jsql)
       Next
       '---------------------
 Dim znum As Double '计算总金额
 For i = 1 To Grid2.Rows - 1
 If Grid2.Cell(i, 7).Text <> "" And Grid2.Cell(i, 1).Text <> "" Then
 znum = znum + Val(Grid2.Cell(i, 7).Text)
 End If
 '----------------------
Next
Grid3.Cell(1, 5).Text = znum

    jsql = "insert into 销售单据(审核,单号,单位,日期,批号,总金额,制单人) values('0','" & Grid3.Cell(1, 1).Text & "','" & Grid3.Cell(1, 2).Text & "','" & Grid3.Cell(1, 3).Text & "','" & Grid3.Cell(1, 4).Text & "','" & Grid3.Cell(1, 5).Text & "','" & loginname & "')"
    Set qy1save = cnn.Execute(jsql)
       MsgBox "销售任务己完成,将等待审核通过!", vbInformation, "完成操作"
Call asPopup1_Click(True)
gridsave = True
griddelete = False '拒绝删除
gridedit = False
Exit Sub
tkFinish:
MsgBox Err.Description
End Sub

Private Sub XPButton6_Click()
On Error GoTo tkFinish
If griddelete = False Or hang1 = 0 Then
MsgBox "当前修改操作不被允许!", vbInformation, "非使用对象"
Exit Sub
End If
Dim delok As String
delok = MsgBox("此操作会删除单号为" & Grid1.Cell(hang1, 1).Text & "的所有数据，是否确定？？", vbQuestion + vbOKCancel, "提示")
If delok = vbOK Then
sql = "delete from 销售单据 where 单号='" & Grid1.Cell(hang1, 1).Text & "'"
Set qy2 = cnn.Execute(sql)
sql = "delete from 销售记录 where 批号='" & Grid1.Cell(hang1, 1).Text & "'"
Set qy2 = cnn.Execute(sql)
MsgBox "己完成修改操作!", , "提示"
End If
Exit Sub
tkFinish:
MsgBox Err.Description
End Sub

Private Sub XPButton7_Click()
On Error GoTo tkFinish
If FCombo1.Text <> "" And Text1.Text <> "" And Text2.Text <> "" Then
jsql = "select sum(总金额) from 销售单据 where 单位='" & FCombo1.Text & "' and 日期>'" & Text1.Text & "' and 日期<'" & Text2.Text & "'"
Set qy3 = cnn.Execute(jsql)
MsgBox "您所查询的总金额为" & qy3.Fields(0)
End If
Exit Sub
tkFinish:
MsgBox Err.Description
End Sub

Private Sub XPButton8_Click()
On Error GoTo tkFinish
If FCombo2.Text <> "" And Text3.Text <> "" And Text5.Text <> "" Then
gridsave = False
yuzhi = False
Grid1.Cell(0, 0).SetFocus '防止数据被覆盖
If XPCheckBox1.Value <> xcksChecked Then
jsql = "select * from 销售单据 where 单位='" & FCombo2.Text & "' and 日期>'" & Text3.Text & "' and 日期<'" & Text5.Text & "' order by 序号 desc"
Else
jsql = "select 销售单据.* from 销售单据,销售记录 where 销售单据.单位='" & FCombo2.Text & "' and 销售单据.日期>'" & Text3.Text & "' and 销售单据.日期<'" & Text5.Text & "' and 销售单据.批号=销售记录.批号 and 销售记录.商品名称='" & Text6.Text & "' order by 销售单据.序号 desc"
End If
sellnote
gridsave = False
griddelete = True
gridedit = True
XPFrame3.Visible = False
End If
Exit Sub
tkFinish:
MsgBox Err.Description
End Sub

Private Sub XPButton9_Click()
XPFrame3.Visible = False
End Sub