VB开发的ERP系统

    LB_OtherOutBillList.Show
    LBCX_OtherOutBillListFind.Show 1
    Security_Log "Chhs_OtheOutBillList", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_Outsum_Click()           '出库单汇总表
     '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_OutBillSum", Xtczybm, 1) Then
        Exit Sub
    End If
    Tjfx_OutBillSum.Show
    Tjfx_OutBillSumCond.Show 1
    Security_Log "Chhs_OutBillSum", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_Prodinbill_Click()                    '产品入库单
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_ProdInEdit", Xtczybm, 1) Then
        Exit Sub
    End If
    If Xt_XtJc Then
        If Not Sub_Records(Xtrq, "chhs_V_ProductInBill") Then
            Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
            Call Xtxxts(Tsxx, 0, 4)
        Else
            Xtcdcs = "1"
            DJ_ProdInBill.Show 1
            Security_Log "Chhs_ProdInEdit", Xtczybm, 2, False  '用户退出时写上机日志
        End If
    Else
        Xtcdcs = "1"
        DJ_ProdInBill.Show 1
        Security_Log "Chhs_ProdInEdit", Xtczybm, 2, False  '用户退出时写上机日志
    End If
End Sub

Private Sub Chhs_Prodinbilllist_Click()
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_ProdInBillList", Xtczybm, 1) Then
        Exit Sub
    End If
    LB_ProdInBillList.Show
    LBCX_ProdInBillListFind.Show 1
    Security_Log "Chhs_ProdInBillList", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_ProdPrice_Click()              '产品成本调整
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_ProdPrice", Xtczybm, 1) Then
        Exit Sub
    End If
    Cl_ProdPrice.Show
    Cl_ProdPriceCond.Show 1
    Security_Log "Chhs_ProdPrice", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_Qcjz_Click()                   '期初单据记帐
Dim Rectemp As Recordset
     
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_Qcjz", Xtczybm, 1) Then
        Exit Sub
    End If
    
    If Xtyear <> PGKjYear Then
        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + "),请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where beginflag=1")
    If Rectemp.Fields("chhsjzbz") Then
        Tsxx = "期初月份已结帐,不允许期初记帐或恢复记帐操作!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' ")
    If Rectemp.EOF Then
        Tsxx = "没有进行仓库设置!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    Else
        Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' and Gy_WareHouse.EndDealFlagChhs=0")
        If Rectemp.EOF Then
            Tsxx = "仓库已全部期末处理,不允许进行记帐或恢复记帐操作!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        End If
    End If
    Set Rectemp = Nothing

    Start_BillChalkitup.Show
    Start_BillChalkitupCond.Show 1
    Security_Log "Chhs_Qcjz", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_Qmcl_Click()                  '期末处理
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_Qmcl", Xtczybm, 1) Then
        Exit Sub
    End If
    If Xtyear <> PGKjYear Then
        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
    Else
        CL_EndDispose.Show 1
        Security_Log "Chhs_Qmcl", Xtczybm, 2, False  '用户退出时写上机日志
    End If
End Sub

Private Sub Chhs_Qmjz_Click()                '期末结帐
Dim Rectemp As Recordset
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_Qmjz", Xtczybm, 1) Then
        Exit Sub
    End If
    If Xtyear <> PGKjYear Then
        Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where kjyear=" & PGKjYear - 1 & " order by period desc")
        If Not Rectemp.EOF Then
            If Xtmm = Rectemp.Fields("period") Then
                CL_EndCheckOut.Dyear = PGKjYear - 1
                CL_EndCheckOut.Dmonth = Xtmm
                CL_EndCheckOut.Timer1 = True
                CL_EndCheckOut.Opt_Qmjz.Enabled = False
                CL_EndCheckOut.Opt_Hfqmjz.Value = True
                CL_EndCheckOut.Show 1
                Security_Log "Chhs_Qmjz", Xtczybm, 2, False  '用户退出时写上机日志
            Else
                Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
                Call Xtxxts(Tsxx, 0, 1)
            End If
        Else
            Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + ")之内,请重新登录!"
            Call Xtxxts(Tsxx, 0, 1)
        End If
    Else
        CL_EndCheckOut.Dyear = PGKjYear
        CL_EndCheckOut.Dmonth = PGNowmon
        CL_EndCheckOut.Timer1 = True
        CL_EndCheckOut.Show 1
        Security_Log "Chhs_Qmjz", Xtczybm, 2, False  '用户退出时写上机日志
    End If
            
End Sub

Private Sub Chhs_quit_Click()          '退出系统
    On Error Resume Next
    
    Dim Jsqte As Integer
    If Not Tcxt Then
        Cancel = True
    Else
        Unload_TF = True
        For Jsqte = 0 To Forms.count - 1
            Unload Forms(Jsqte)
        Next Jsqte
        End
    End If
End Sub

Private Sub Chhs_Register_Click()     '重新注册
    XT_login.Show 1
End Sub

Private Sub Chhs_Selloutbill_Click()      '销售出库单
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_SellOutEdit", Xtczybm, 1) Then
        Exit Sub
    End If
    If Xt_XtJc Then
        If Not Sub_Records(Xtrq, "Chhs_V_SellOutBill") Then
            Tsxx = CStr(Format(Xtrq, "yyyy-mm-dd")) + " 无单据!"
            Call Xtxxts(Tsxx, 0, 4)
        Else
            Xtcdcs = "1"
            DJ_SellOutBill.Show 1
            Security_Log "Chhs_SellOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
        End If
    Else
        Xtcdcs = "1"
        DJ_SellOutBill.Show 1
        Security_Log "Chhs_SellOutEdit", Xtczybm, 2, False  '用户退出时写上机日志
    End If
End Sub

Private Sub Chhs_Seloutbilllist_Click()              '销售出库单列表
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_SellOutBillList", Xtczybm, 1) Then
        Exit Sub
    End If
    LB_SellOutBillList.Show
    LBCX_SellOutBillListFind.Show 1
    Security_Log "Chhs_SellOutBillList", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_Sfchz_Click()                '收发存汇总表
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_Sfchz", Xtczybm, 1) Then
        Exit Sub
    End If
    Tjfx_Sfchz.Show
    Tjfx_SfchzCond.Show 1
    Security_Log "Chhs_Sfchz", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_Startbill_Click()            '期初单据录入
Dim Rectemp As Recordset

    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_StartBillEdit", Xtczybm, 1) Then
        Exit Sub
    End If
    
    If Xtyear <> PGKjYear Then
        Tsxx = "操作日期不在当前会计年度(" + Trim(Str(PGKjYear)) + "),请重新登录!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select * from gy_kjrlb where beginflag=1")
    If Rectemp.Fields("chhsjzbz") Then
        Tsxx = "期初月份已结帐,不允许期初单据录入!"
        Call Xtxxts(Tsxx, 0, 1)
        Exit Sub
    End If
    
    Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' ")
    If Rectemp.EOF Then
        Tsxx = "没有进行仓库设置!"
        Call Xtxxts(Tsxx, 0, 4)
        Exit Sub
    Else
        Set Rectemp = Cw_DataEnvi.DataConnect.Execute("select Gy_WareHouse.whcode from Gy_WareHouse left outer join Gy_Whlimit on Gy_WareHouse.whcode=Gy_Whlimit.whcode where Gy_Whlimit.czybm='" & Xtczybm & "' and Gy_WareHouse.EndDealFlagChhs=0")
        If Rectemp.EOF Then
            Tsxx = "仓库已全部期末处理,不允许期初单据录入!"
            Call Xtxxts(Tsxx, 0, 4)
            Exit Sub
        End If
    End If
    Set Rectemp = Nothing
    
    Xtcdcs = "1"
    Start_BillInput.Show 1
    Security_Log "Chhs_StartBillEdit", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_Startbilllist_Click()          '期初单据列表
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_StartBillList", Xtczybm, 1) Then
        Exit Sub
    End If
    Start_BillInputList.Show
    Start_BillListCond.Show 1
    Security_Log "Chhs_StartBillList", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub Chhs_xtbz_Click()                  '帮助
     Call F1bz
End Sub

Private Sub Chhs_Ywfw_Click()                   '业务范围
    Jcsz_Ywfw.Show 1
End Sub

Private Sub Chhs_Zz_Click()                    '总帐
    '判断用户是否有此功能执行权限,如有则写上机日志(进入)
    If Not Security_Log("Chhs_Zz", Xtczybm, 1) Then
        Exit Sub
    End If
    Zbfx_Mate.Show
    Zbfx_MateCond.Show 1
    Security_Log "Chhs_Zz", Xtczybm, 2, False  '用户退出时写上机日志
End Sub

Private Sub MDIForm_Activate()                    '主窗体击活
    Timer1.Enabled = True
End Sub

Private Sub MDIForm_Load()
   
    '调入主操作界面
    Xt_Control.Show

End Sub

Private Sub MDIForm_QueryUnload(Cancel As Integer, UnloadMode As Integer)
        
    On Error Resume Next
    
    Dim Jsqte As Integer
    If Not Tcxt Then
        Cancel = True
    Else
        Unload_TF = True
        For Jsqte = 0 To Forms.count - 1
            Unload Forms(Jsqte)
        Next Jsqte
        End
    End If

End Sub

Private Sub mnuWindowArrangeIcons_Click()                                   '窗口排列图标
    Me.Arrange vbArrangeIcons
End Sub

Private Sub mnuWindowTileVertical_Click()                                   '窗口纵向平铺
    Me.Arrange vbTileVertical
End Sub

Private Sub mnuWindowTileHorizontal_Click()                                 '窗口横向平铺
    Me.Arrange vbTileHorizontal
End Sub

Private Sub mnuWindowCascade_Click()                                        '窗口层叠
    Me.Arrange vbCascade
End Sub

'************************'以下为程序固定不变部分*********************'

Private Function Tcxt() As Boolean                                       '退出系统提示
    Dim Answer As Integer
    Tsxx = "请确认是否退出系统？"
    Answer = Xtxxts(Tsxx, 2, 2)
    If Answer = 1 Then
        Tcxt = True
    Else
        Tcxt = False
    End If

End Function

Private Sub Timer1_Timer()                                        '在窗体激活后调入程序
    
    Timer1.Enabled = False
    If XT_login.QdCheck.Value = 1 Then
        Call Xtcsh
        XT_login.QdCheck.Value = 0
    End If

End Sub

Private Sub Xtcsh()                                               '系统主控制台及全局变量初始化
    
    With XT_login
        Xtczybm = Trim(Mid(.CzyCombo.Text, 1, InStr(1, .CzyCombo.Text, "-") - 1))
        Xtczy = Trim(Mid(.CzyCombo.Text, InStr(1, .CzyCombo.Text, "-") + 1, Len(.CzyCombo.Text)))
        Xtztbm = Trim(Mid(.ZtCombo.Text, 1, InStr(1, .ZtCombo.Text, "-") - 1))
        Xtdwm = Trim(Mid(.ZtCombo.Text, InStr(1, .ZtCombo.Text, "-") + 1, Len(.ZtCombo.Text)))
        Xtkjqjgs = 12
        
        '业务操作日期
        Xtrq = CDate(.CzrqText.Text)
        
        '用户选择系统年度
        Xtyear = Val(.KjyearCombo.Text)
        
        '用户选择系统会计期间
        Set Xtrlrec = Cw_DataEnvi.DataConnect.Execute("Select * From Gy_kjrlb where qsrq<='" + .CzrqText.Text + "' and zzrq>='" + .CzrqText.Text + "'")
        If Not Xtrlrec.EOF Then
            Xtmm = Xtrlrec.Fields("Period")
        End If
    
    End With
    
    With XT_Main.StatusBar1
        .Panels("OperStatus") = "就绪"
        .Panels("zt").Text = Xtdwm
        .Panels("czy").Text = Xtczy
        .Panels("rq").Text = "业务日期:" + Format(Xtrq, "yyyy-mm-dd")
        .Panels("rjbb").Text = "【百利/ERP】"
    End With

End Sub