frmmain.frm

库存管理系统,有详细的代码,就是没论文.VB+ACCE

VERSION 5.00
Begin VB.MDIForm frmMain 
   BackColor       =   &H8000000C&
   Caption         =   "四川百事可乐公司仓库库存管理系统"
   ClientHeight    =   4080
   ClientLeft      =   60
   ClientTop       =   630
   ClientWidth     =   7605
   Icon            =   "frmMain.frx":0000
   LinkTopic       =   "MDIForm1"
   StartUpPosition =   2  '屏幕中心
   WindowState     =   2  'Maximized
   Begin VB.Menu mnuSet_jczl 
      Caption         =   "基础资料设置"
      Begin VB.Menu mnuSet_department 
         Caption         =   "部门设置"
      End
      Begin VB.Menu mnuSet_employee 
         Caption         =   "员工设置"
      End
      Begin VB.Menu mnuSet_protype 
         Caption         =   "物品类别设置"
      End
      Begin VB.Menu mnuSet_product 
         Caption         =   "物品设置"
      End
      Begin VB.Menu mnuSet_supplier 
         Caption         =   "供应商设置"
      End
   End
   Begin VB.Menu mnuAct_dj 
      Caption         =   "单据处理"
      Begin VB.Menu mnuAct_orders 
         Caption         =   "入库单处理"
         Begin VB.Menu mnuAct_ps 
            Caption         =   "采购入库单"
            Begin VB.Menu mnuEdit_ps 
               Caption         =   "采购入库单编辑"
            End
            Begin VB.Menu mnuRec_ps 
               Caption         =   "采购入库单审核"
            End
         End
         Begin VB.Menu mnuAct_other 
            Caption         =   "其它入库单"
            Begin VB.Menu mnuEdit_other 
               Caption         =   "其它入库单编辑"
            End
            Begin VB.Menu mnuRec_other 
               Caption         =   "其它入库单审核"
            End
         End
      End
      Begin VB.Menu mnuAct_sales 
         Caption         =   "出库单处理"
         Begin VB.Menu mnuEdit_sales 
            Caption         =   "出库单编辑"
         End
         Begin VB.Menu mnuRec_sales 
            Caption         =   "出库单审核"
         End
      End
      Begin VB.Menu mnuAct_mat 
         Caption         =   "库存调整单处理"
         Begin VB.Menu mnuEdit_mat 
            Caption         =   "库存调整单编辑"
         End
         Begin VB.Menu mnuRec_mat 
            Caption         =   "库存调整单审核"
         End
      End
   End
   Begin VB.Menu mnuSql 
      Caption         =   "统计查询"
      Begin VB.Menu mnuSql_dj 
         Caption         =   "已过帐单据查询"
         Begin VB.Menu mnuSql_djps 
            Caption         =   "采购入库单"
         End
         Begin VB.Menu mnuSql_djother 
            Caption         =   "其它入库单"
         End
         Begin VB.Menu mnuSql_djsales 
            Caption         =   "出库单"
         End
         Begin VB.Menu mnuSql_djmat 
            Caption         =   "库存调整单"
         End
      End
   End
   Begin VB.Menu mnuSystem 
      Caption         =   "系统维护"
      Begin VB.Menu mnuSys_begqty 
         Caption         =   "期初库存录入"
      End
      Begin VB.Menu mnuSys_start 
         Caption         =   "系统启用"
      End
      Begin VB.Menu mnuSys_user 
         Caption         =   "操作员设置"
      End
      Begin VB.Menu mnuSys_delete 
         Caption         =   "资料删除"
      End
      Begin VB.Menu mnuSys_trans 
         Caption         =   "月终结转"
      End
   End
   Begin VB.Menu mnuReport 
      Caption         =   "报表输出"
      Begin VB.Menu mnuReport_Mat 
         Caption         =   "仓库库存报表"
      End
      Begin VB.Menu mnuReport_Use 
         Caption         =   "领用报表"
         Begin VB.Menu mnuReport_DetailUse 
            Caption         =   "部门领用明细表"
         End
         Begin VB.Menu mnuReport_TotalUse 
            Caption         =   "部门领用汇总表"
         End
         Begin VB.Menu mnuReport_TotalYearUse 
            Caption         =   "部门领用年度汇总表"
         End
      End
   End
   Begin VB.Menu mnuExit 
      Caption         =   "退出系统"
   End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private rsSys As ADODB.Recordset
Private cmSys As ADODB.Command

Private Sub MDIForm_Load()
    Dim strSQL As String
    strSQL = "select offline from r_parameter"
    Set rsSys = New ADODB.Recordset
    rsSys.Open strSQL, DEjxc.Conjxc, adOpenDynamic, adLockOptimistic
    rsSys.MoveFirst
    If rsSys!offline Then
        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
    Else
        Me.mnuAct_dj.Enabled = True
        Me.mnuSql.Enabled = True
        Me.mnuReport.Enabled = True
        Me.mnuSys_trans.Enabled = True
        Me.mnuSys_start.Enabled = False
        Me.mnuSys_begqty.Enabled = False
    End If
    rsSys.Close
    Set cmSys = New ADODB.Command
    cmSys.ActiveConnection = DEjxc.Conjxc
    cmSys.CommandType = adCmdText
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()
    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 IsDate(strBeg) Then
        strYear = Right(CStr(Year(CDate(strBeg))), 2)
        strMonth = Format(CStr(Month(CDate(strBeg))), "0#")
        strSQL = "alter table mat_head add column qty" & strYear & strMonth _
        & " single"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "alter table mat_head add column price" & strYear & strMonth _
        & " currency"
        cmSys.CommandText = strSQL
        cmSys.Execute
        strSQL = "update mat_head set qty" & strYear & strMonth & "=qty," & _
        " price" & strYear & strMonth & "=price"
        cmSys.CommandText = strSQL
        cmSys.Execute
        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 IsDate(strBeg) Then
        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
            strYear = Right(CStr(Year(CDate(strBeg))), 2)
            strMonth = Format(CStr(Month(CDate(strBeg))), "0#")
            strSQL = "alter table mat_head add column qty" & strYear & strMonth _
            & " single"
            cmSys.CommandText = strSQL
            cmSys.Execute
            strSQL = "alter table mat_head add column price" & strYear & strMonth _
            & " currency"
            cmSys.CommandText = strSQL
            cmSys.Execute
            strSQL = "update mat_head set qty" & strYear & strMonth & "=qty," & _
            " price" & strYear & strMonth & "=price"
            cmSys.CommandText = strSQL
            cmSys.Execute
            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