frmmain.frm

里面的内容包括：基盘存管理本信息管理库存管理入库管理出库管理等功能

      '单击“员工管理”对应的Label控件，弹出员工管理窗体模块
      mnuSet_employee_Click
      Exit Sub
  Case 3
      '单击“物品”对应的Label控件，弹出物品管理窗体模块
      mnuSet_product_Click
      Exit Sub
  Case 4
     '单击“供应商管理”对应的Label控件，弹出供应商管理管理窗体模块
      mnuSet_supplier_Click
      Exit Sub
   Case 5
      '单击“物品类别管理”对应的Label控件，弹出物品类别管理管理窗体模块
      mnuSet_protype_Click
      Exit Sub
End Select
End Sub

Private Sub Labtjcx_Click(Index As Integer)
Select Case Index
  Case 1  '入库单查询
       mnuSql_djps_Click
       Exit Sub
  Case 2   '出库单管理
      mnuSql_djsales_Click
      Exit Sub
  Case 3  '
     Exit Sub
End Select
End Sub

Private Sub Labxtwh_Click(Index As Integer)
Select Case Index
 ' Case 1  '期初库存录入
  '     mnuSys_begqty_Click
   '    Exit Sub
  Case 1   '系统启用
      mnuSys_start_Click
      Exit Sub
  Case 2  '操作员设置
      mnuSys_user_Click
      Exit Sub
  Case 3   '资料删除
      mnuSys_delete_Click
      Exit Sub
   Case 4   '月终结转
      mnuSys_trans_Click
      Exit Sub
End Select
End Sub

Private Sub MDIForm_Load()
    '定义存储sql语句的变量strSQL
    Dim strSQL As String
    'strSQL = "select offline from r_parameter"
    '设置并执行变量strSQL代表的sql语句,已返回数据集rsSys，
    '使其返回users表中的用户名为全局变量strCurUser代表的值的记录
    strSQL = "select * from users where user_name='" & strCurUser & "'"
    Set rsSys = New ADODB.Recordset
    rsSys.Open strSQL, DEjxc.Conjxc, adOpenDynamic, adLockOptimistic
    rsSys.MoveFirst
     '判断是否存在该用户
     If Not rsSys.EOF Then
        '存在该用户，根据系统登陆用户的操作权限来设置各个菜单项的使能状态
       Dim i As Integer
       Me.mnuAct_dj.Enabled = rsSys.Fields("单据管理")
       For i = 0 To Me.Labdjcl.Count - 1
         Me.Labdjcl(i).Enabled = rsSys.Fields("单据管理")
       Next i
       Me.mnuSql.Enabled = rsSys.Fields("统计查询")
       For i = 0 To Me.Labtjcx.Count - 1
         Me.Labtjcx(i).Enabled = rsSys.Fields("统计查询")
       Next i
       Me.mnuReport.Enabled = rsSys.Fields("报表管理")
       For i = 0 To Me.Labbbgl.Count - 1
         Me.Labbbgl(i).Enabled = rsSys.Fields("报表管理")
       Next i
       Me.mnuSet_jczl.Enabled = rsSys.Fields("辅助项目管理")
       For i = 0 To Me.Labfzxmgl.Count - 1
         Me.Labfzxmgl(i).Enabled = rsSys.Fields("辅助项目管理")
       Next i
       Me.mnuSystem.Enabled = rsSys.Fields("系统维护")
       For i = 0 To Me.Labxtwh.Count - 1
         Me.Labxtwh(i).Enabled = rsSys.Fields("系统维护")
       Next i
    End If
    '关闭数据集对象rsSys
    rsSys.Close
    '初始化主窗体中用到的命令对象cmSys
    Set cmSys = New ADODB.Command
    '设置命令对象cmSys的数据库连接对象
    cmSys.ActiveConnection = DEjxc.Conjxc
    cmSys.CommandType = adCmdText
    '在系统主窗体右侧PictureBox容器中的Label控件中显示当前日期和登陆用户名称
    Me.Labdqrq(1).Caption = Date
    Me.Labczyh(1).Caption = strCurUser
End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    Call mnuExit_Click
    If intNumWindows > 0 Then
        Cancel = True
    End If
    Set rsSys = Nothing
    Set cmSys = Nothing
End Sub

Private Sub mnuEdit_other_Click()
    FrmOtherEdit.Show
End Sub

Private Sub mnuEdit_ps_Click()
    FrmPsEdit.Show
End Sub

Private Sub mnuEdit_sales_Click()
    FrmSaleEdit.Show
End Sub

Private Sub mnuExit_Click()
    If intNumWindows = 0 Then
        Unload Me
    Else
        MsgBox "请关闭所有子程序后再关闭该主程序！", vbCritical, "提示"
    End If
End Sub

Private Sub mnuRec_other_Click()
    FrmOtherChk.Show
End Sub

Private Sub mnuRec_ps_Click()
    FrmPsChk.Show
End Sub

Private Sub mnuRec_sales_Click()
   FrmSaleChk.Show
End Sub

Private Sub mnuReport_DetailUse_Click()
    FrmRptDetUse.Show
End Sub

Private Sub mnuReport_Mat_Click()
    FrmRptMat.Show
End Sub

Private Sub mnuReport_TotalUse_Click()
    FrmRptTotUse.Show
End Sub

Private Sub mnuReport_TotalYearUse_Click()
    FrmRptYearUse.Show
End Sub

Private Sub mnuSet_department_Click()
    Load FrmSetDep
    FrmSetDep.Show
End Sub

Private Sub mnuSet_employee_Click()
    FrmSetEmp.Show
End Sub

Private Sub mnuSet_product_Click()
    FrmSetPro.Show
End Sub

Private Sub mnuSet_protype_Click()
    FrmSetPrTy.Show
End Sub

Private Sub mnuSet_supplier_Click()
    FrmSetSup.Show
End Sub

Private Sub mnuSql_djother_Click()
    FrmOtherSql.Show
End Sub

Private Sub mnuSql_djps_Click()
    FrmPsSql.Show
End Sub

Private Sub mnuSql_djsales_Click()
    FrmSaleSql.Show
End Sub

Private Sub mnuSys_begqty_Click()
    FrmSetMattmp.Show
End Sub

Private Sub mnuSys_delete_Click()
    Dim intDel As Integer
    Dim strSQL As String
    intDel = MsgBox("确认要删除所有资料码?", vbInformation + vbYesNo, "删除确认")
    If intDel = vbYes Then
        strSQL = "delete from department"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from employee"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from mat_detail"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from mat_head"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "select p_id,qty,price into mat_tmp from mat_head"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "drop table mat_head"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "select p_id,qty,price into mat_head from mat_tmp"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "update mat_head set qty=0,price=0"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "drop table mat_tmp"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from product"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from product_type"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from supplier"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from order_detail_a"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from order_detail_b"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from ps_head_a"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from ps_head_b"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from other_head_a"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from other_head_b"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from sale_detail_a"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from sale_detail_b"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from sale_head_a"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "delete from sale_head_b"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "update r_parameter set offline=true,psnumber=0"
        cmSys.CommandText = strSQL
        cmSys.Execute
        MsgBox "资料删除完毕!", vbInformation, "资料删除"
    End If
    Me.mnuAct_dj.Enabled = False
    Me.mnuSql.Enabled = False
    Me.mnuReport.Enabled = False
    Me.mnuSys_trans.Enabled = False
    Me.mnuSys_start.Enabled = True
   ' Me.mnuSys_begqty.Enabled = True
End Sub

Private Sub mnuSys_start_Click()
    Dim strBeg As String
    Dim strYear, strMonth As String
    Dim strSQL As String
    '弹出对话框，要求用户输入系统启用的时间
    strBeg = InputBox("请输入系统启用时间", "系统启用", CStr(Date))
    '判断输入的时间是否为空，如果为空，则退出该过程
    If strBeg = "" Then
      Exit Sub
    End If
    '判断输入的系统启用时间是否符合日期格式
    If IsDate(strBeg) Then
        '输入的系统启用时间符合日期格式
        '从变量strBeg表示的日期中取出年份
        strYear = Right(CStr(Year(CDate(strBeg))), 2)
        '从变量strBeg表示的日期中取出月份
        strMonth = Format(CStr(Month(CDate(strBeg))), "0#")
        '设置并执行sql语句，在表mat_head中添加一个single类型的字段qty
        strSQL = "alter table mat_head add column qty" & strYear & strMonth _
        & " single"
        cmSys.CommandText = strSQL
        cmSys.Execute
        '设置并执行sql语句，在表mat_head中添加一个currency类型的字段price
        strSQL = "alter table mat_head add column price" & strYear & strMonth _
        & " currency"
        cmSys.CommandText = strSQL
        cmSys.Execute
        '设置并执行sql语句，更改表mat_head中的字段qty和price的值,
        '即存储当前物品的总数量和总金额
        strSQL = "update mat_head set qty" & strYear & strMonth & "=qty," & _
        " price" & strYear & strMonth & "=price"
        cmSys.CommandText = strSQL
        cmSys.Execute
         '设置并执行sql语句，更改表r_parameter中的字段pass_date、offline和monthdate的值,
         '即存储系统的启用时间和月结转时间
        strSQL = "update r_parameter set pass_date=cdate('" & strBeg & _
        "'),offline=false,monthdate=cdate('" & strBeg & "')"
        cmSys.CommandText = strSQL
        cmSys.Execute
        '设置菜单项的使能状态
        Me.mnuAct_dj.Enabled = True
        Me.mnuSql.Enabled = True
        Me.mnuReport.Enabled = True
        Me.mnuSys_trans.Enabled = True
        Me.mnuSys_start.Enabled = False
        '弹出对话框，提示用户系统已正式启用
        MsgBox "系统已正式启用!", vbInformation, "系统启用"
    Else
        '输入的系统启用时间不符合日期格式，给出错误提示
        MsgBox "日期格式错误！", vbCritical, "启用错误"
        Exit Sub
    End If
End Sub

Private Sub mnuSys_trans_Click()
    Dim strBeg As String
    Dim strYear, strMonth As String
    Dim strSQL As String
    '弹出对话框，要求用户输入月终结转时间
    strBeg = InputBox("请输入月终结转时间", "月终结转", CStr(Date))
     '判断输入的系统启用时间是否为空
    If strBeg = "" Then
        '输入的系统启用时间为空，退出该过程
       Exit Sub
    End If
     '判断输入的系统启用时间是否符合日期格式
    If IsDate(strBeg) Then
        '输入的系统启用时间符合日期格式
        '设置并执行sql语句，已返回表 r_parameter中的记录
        strSQL = "select monthdate from r_parameter"
        Set rsSys = New ADODB.Recordset
        rsSys.Open strSQL, DEjxc.Conjxc, adOpenDynamic, adLockOptimistic
        rsSys.MoveFirst
        '判断输入的月终结转时间是否大于上次结转的时间
        If Format(CDate(strBeg), "yyyy-mm") > Format(rsSys!monthdate, "yyyy-mm") Then
            '输入的月终结转时间大于上次结转的时间
            ' 从变量strBeg表示的日期中取出年份
            strYear = Right(CStr(Year(CDate(strBeg))), 2)
            '从变量strBeg表示的日期中取出月份
            strMonth = Format(CStr(Month(CDate(strBeg))), "0#")
            '设置并执行sql语句，在表mat_head中添加一个single类型的字段qty
            strSQL = "alter table mat_head add column qty" & strYear & strMonth _
            & " single"
            cmSys.CommandText = strSQL
            cmSys.Execute
             '设置并执行sql语句，在表mat_head中添加一个currency类型的字段price
            strSQL = "alter table mat_head add column price" & strYear & strMonth _
            & " currency"
            cmSys.CommandText = strSQL
            cmSys.Execute
             '设置并执行sql语句，更改表mat_head中的字段qty和price的值,
             '即存储当前物品的总数量和总金额
            strSQL = "update mat_head set qty" & strYear & strMonth & "=qty," & _
            " price" & strYear & strMonth & "=price"
            cmSys.CommandText = strSQL
            cmSys.Execute
             '设置并执行sql语句，更改表r_parameter中的字段monthdate的值，
             '即存储此次月结转的操作日期
            strSQL = "update r_parameter set monthdate=cdate('" & strBeg & "')"
            cmSys.CommandText = strSQL
            cmSys.Execute
             '弹出对话框，提示用户系统月份结转完毕
            MsgBox "月份结转完毕!", vbInformation, "月终结转"
        Else
            '输入的月终结转时间不大于上次结转的时间，给出“该月份已经月终结转”的提示
            MsgBox "该月份已经月终结转!", vbCritical, "月终结转错误"
        End If
    Else
         '输入的系统启用时间不符合日期格式，给出错误提示
        MsgBox "日期格式错误！", vbCritical, "启用错误"
        Exit Sub
    End If
End Sub

Private Sub mnuSys_user_Click()
    FrmSetUser.Show
End Sub