frmmain.frm

企业事务管理系统(程序+打包)是《数据库系统开发项目方案精解系列丛书VB数据库管理》附带CD中的程序。

    End If
End Sub

Private Sub chkDutyTopic_Click()
    If Me.chkDutyTopic.Value = 0 Then
        Me.txtDutyTopic.Enabled = False         '委办事项不可用
    Else
        Me.txtDutyTopic.Enabled = True          '委办事项可用
    End If
End Sub

Private Sub chkMeetingDate_Click()
    If Me.chkMeetingDate.Value = vbChecked Then
        Me.DTPmeetingStart.Enabled = True       '开会日期栏可用
        Me.DTPmeetingEnd.Enabled = True
    Else
        Me.DTPmeetingStart.Enabled = False      '开会日期栏不可用
        Me.DTPmeetingEnd.Enabled = False
    End If
End Sub

Private Sub chkMeetingMaster_Click()
    If Me.chkMeetingMaster.Value = vbChecked Then
        Me.Combo_meetingmaster.Enabled = True       '主持人栏可用
    Else
        Me.Combo_meetingmaster.Enabled = False      '主持人栏不可用
    End If
End Sub

Private Sub chkMeetingPeople_Click()
    If Me.chkMeetingPeople.Value = vbChecked Then
        Me.txtMeetingPoeple.Enabled = True      '相关人员栏可用
    Else
        Me.txtMeetingPoeple.Enabled = False     '相关人员栏不可用
    End If
End Sub

Private Sub chkMeetingPri_Click()
    If Me.chkMeetingPri.Value = vbChecked Then
        Me.Combo_meetingPri.Enabled = True      '重要性栏可用
    Else
        Me.Combo_meetingPri.Enabled = False     '重要性栏不可用
    End If
End Sub

Private Sub chkMeetingTopic_Click()
    If Me.chkMeetingTopic.Value = vbChecked Then
        Me.Combo_meetingtopic.Enabled = True    '会议主题栏可用
    Else
        Me.Combo_meetingtopic.Enabled = False   '会议主题栏不可用
    End If
End Sub

Private Sub cmdBuyCarClear_Click()
    Me.txtBuyCarID = ""                         '清除“车辆编号”
    Me.txtBelong = ""                           '清除“使用人或部门”
    Me.txtBuyPrice = ""                         '清除“购买价格”
    Me.txtDriver = ""                           '清除“驾驶员”
    Me.txtEngineNo = ""                         '清除“引擎号码”
    Me.txtLicense = ""                          '清除“车牌号”
    Me.txtOutAir = ""                           '清除“排气量”
    Me.txtType = ""                             '清除“车辆类别”
    Me.DTPBuyDate = Date                        '清除“购置日期”
End Sub

Private Sub cmdDutyAdd_Click()
    Module1.BLduty = 0                              '新增“值班”的标志
    frmDuty.Show 1                                  '模式方式打开“值班”窗体
End Sub

Private Sub cmdDutyChange_Click()
    Dim rst As New ADODB.Recordset
    Dim strsql As String
    Dim nowrow As Integer
    Dim nowdutyman As String                     '记录当前行的值班人姓名
    
    nowrow = Me.MSFduty.Row                      '记录当前选中的行
    If nowrow < 1 Then
        MsgBox "必须先选中一条有效记录", vbExclamation, Me.Caption
        Exit Sub
    End If
'    strsql = "select dutyman_name from tbl_dutyman where dutyman_id=" _
'        & me.MSFduty.TextMatrix(me.MSFduty.Row,6)
    With frmDuty
        .DTPDutyStart = Format(Me.MSFduty.TextMatrix(nowrow, 1), "long date")
        .Combo_DutyStart = Me.MSFduty.TextMatrix(nowrow, 2)
        .DTPDutyEnd = Format(Me.MSFduty.TextMatrix(nowrow, 3), "long date")
        .Combo_DutyEnd = Me.MSFduty.TextMatrix(nowrow, 4)
        .Combo_DutyMan = Me.MSFduty.TextMatrix(nowrow, 5)
        .txtCaseNum = Me.MSFduty.TextMatrix(nowrow, 6)
        .txtDutyTopic = Me.MSFduty.TextMatrix(nowrow, 7)
        .txtContent = Me.MSFduty.TextMatrix(nowrow, 8)
        .txtDutyID = Me.MSFduty.TextMatrix(nowrow, 0)
                            '隐藏的DutyID文本框记录当前要修改的记录编号
    End With
    Module1.BLduty = 1                            '修改“值班”的标志
    frmDuty.Show 1
End Sub

Private Sub cmdDutyCheck_Click()
    Dim intdutyman As Integer                       '记录值班人编码
    Dim rst As New ADODB.Recordset
    Dim strsql As String
    Dim rst2 As New ADODB.Recordset
    Dim strsql2 As String
    Dim strwhere As String
    
    If Me.chkDutyMan.Value = 1 And Me.Combo_DutyMan.Text <> "" Then
        strsql = "select dutyman_id from tbl_dutyman where dutyman_name='" _
            & Me.Combo_DutyMan.Text & "'"
        rst.Open strsql, CnnDataBase, adOpenStatic  '得到值班人编号
        If rst.RecordCount <> 1 Then
            MsgBox "值班人数据表中名字有重复！"
            Exit Sub
        End If
        intdutyman = rst!dutyman_id                 '记录下值班人编号
        rst.Close
    End If
    strwhere = ""                                   '查询条件初始化
    If Me.chkDutyStart.Value = 1 Then               '开始日期的条件
        If strwhere = "" Then
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "DateStart >= #" & Me.DTPDutyStart.Value & "#"
        If Me.Combo_DutyStart.Text <> "" Then       '开始时间的条件
            If strwhere = "" Then
                strwhere = " where "
            Else
                strwhere = strwhere & " and "
            End If
            strwhere = strwhere & "TimeStart >= " & CInt(Left(Me.Combo_DutyStart, 1))
        End If
    End If
    If Me.chkDutyEnd.Value = 1 Then                 '截至日期的条件
        If strwhere = "" Then
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "DateEnd <= #" & Me.DTPDutyEnd.Value & "#"
        If Me.Combo_DutyEnd.Text <> "" Then         '截至时间的条件
            If strwhere = "" Then
                strwhere = " where "
            Else
                strwhere = strwhere & " and "
            End If
            strwhere = strwhere & "TimeEnd <= " & CInt(Left(Me.Combo_DutyEnd, 1))
        End If
    End If
    If Me.chkDutyMan.Value = 1 And Me.Combo_DutyMan.Text <> "" Then
        If strwhere = "" Then                       '值班人编码条件
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "DutyManID =" & intdutyman
    End If
    If Me.chkDutyTopic.Value = 1 And Me.txtDutyTopic.Text <> "" Then
        If strwhere = "" Then                       '委办事项模糊查询条件
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "DutyTopic like '%" & Me.txtDutyTopic & "%'"
    End If
    strsql = "select * from tbl_duty "              '设置查询条件语句
    If strwhere <> "" Then
        strsql = strsql & strwhere
    End If
    rst.Open strsql, CnnDataBase, adOpenStatic      '打开查询结果记录集
    Me.MSFduty.Rows = 1                             '清空MSFlexGrid
    If rst.RecordCount = 0 Then                     '记录集为空，退出操作
        Exit Sub
    End If
    With Me.MSFduty
        Do While rst.EOF = False
            .Rows = .Rows + 1                       '增加MSFlex一行空行
            .Row = .Rows - 1
            .TextMatrix(.Row, 0) = rst!DutyID        '向新空行添加记录
            .TextMatrix(.Row, 1) = rst!DateStart
            .TextMatrix(.Row, 2) = rst!timestart & ":00"
            .TextMatrix(.Row, 3) = rst!DateEnd
            .TextMatrix(.Row, 4) = rst!timeend & ":00"
            strsql2 = "select * from tbl_dutyman where dutyman_id=" & rst!DutyManID
            rst2.Open strsql2, CnnDataBase, adOpenStatic
            If rst2.RecordCount <> 1 Then           '查找对应的值班人名
                MsgBox "值班人数据表中有重复！", vbCritical, "数据库错误"
                Exit Sub
            End If
            .TextMatrix(.Row, 5) = rst2!dutyman_Name
            rst2.Close
            .TextMatrix(.Row, 6) = rst!CaseNum
            .TextMatrix(.Row, 7) = rst!DutyTopic
            .TextMatrix(.Row, 8) = rst!Content
            rst.MoveNext
        Loop
        .Row = 0                                    '设置MSFlex默认指向固定行
    End With
    rst.Close                                       '关闭记录集
End Sub

Private Sub cmdDutyClear_Click()
    Me.chkDutyStart.Value = 0                       '清空开始日期
    Me.DTPDutyStart.Value = Date
    Me.Combo_DutyStart.ListIndex = -1
    Me.chkDutyEnd.Value = 0                         '清空截至日期
    Me.DTPDutyEnd.Value = Date
    Me.Combo_DutyEnd.ListIndex = -1
    Me.chkDutyMan.Value = 0                         '值班人条件
    Me.Combo_DutyMan.ListIndex = -1
    Me.chkDutyTopic.Value = 0                       '委办事项条件
    Me.txtDutyTopic = ""
End Sub

Private Sub cmdDutyDel_Click()
    Dim strsql As String
    Dim rst As New ADODB.Recordset
    Dim nowrow As Integer
    
    nowrow = Me.MSFduty.Row                      '记录当前选中的行
    If nowrow < 1 Then
        MsgBox "删除前必须先选中一条有效记录", vbExclamation, Me.Caption
        Exit Sub
    End If
    If MsgBox("确定要删除吗？", vbQuestion + vbYesNo) = vbYes Then
        strsql = "delete from tbl_duty where dutyid=" & _
            Me.MSFduty.TextMatrix(nowrow, 0)
        rst.Open strsql, CnnDataBase                '确定要删除此条记录
        MsgBox "删除完成！", vbInformation, Me.Caption
    Else
        Exit Sub
    End If
    InputMSFduty                                 '向MSFlexduty中添加数据
    cmdDutyClear_Click                           '清理查询条件
End Sub

Private Sub cmdDutyExit_Click()
    Me.PicDuty.Visible = False                      '关闭“值班记录”管理界面
End Sub

Private Sub cmdFixClear_Click()
    Me.txtFixLicense = ""                       '清空“车牌号”一栏
    Me.DTPFixDate = Date                        '维修日期默认当日
    Me.Combo_FixDeep.ListIndex = -1             '清空损坏程度栏
    Me.txtFixName = ""                          '清空维修费用名称
    Me.txtFixMoney = ""                         '清空“金额”一栏
    Me.txtFixMan = ""                           '清空经手人一栏
    Me.txtFixContent = ""                       '维修内容清空
    Me.txtFixNote = ""                          '备注栏清空
End Sub

Private Sub cmdMeetingAdd_Click()
    frmMeeting.Show 1                              '模式方式打开窗体
End Sub

Private Sub cmdMeetingCheck_Click()
    Dim rst As New ADODB.Recordset
    Dim strsql As String
    Dim rst2 As New ADODB.Recordset
    Dim strsql2 As String
    Dim strwhere As String                          '查询语句的条件
    Dim intMasterID As Integer                      '记录会议主持人编号
    
    intMasterID = -1                                '初始化主持人编号
    If Me.chkMeetingMaster.Value = vbChecked And _
        Me.Combo_meetingmaster.Text <> "" Then      '会议主持人条件不为空
        strsql2 = "select * from tbl_master where mastername='" & _
            Me.Combo_meetingmaster.Text & "'"
        rst2.Open strsql2, CnnDataBase, adOpenStatic
        If rst2.RecordCount <> 1 Then
            MsgBox "会议主持人数据表中有重复！", vbCritical, "数据库错误"
            Exit Sub
        End If
        intMasterID = rst2!masterid                 '得到了会议主持人编号
        rst2.Close                                  '关闭临时记录集
    End If
    strsql = "select * from tbl_meeting"            '设置SQL查询语句
    strwhere = ""                                   '设置查询条件
    If Me.chkMeetingTopic.Value = vbChecked And _
        Me.Combo_meetingtopic.Text <> "" Then       '会议主题条件
        If strwhere = "" Then
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "topic='" & Me.Combo_meetingtopic.Text & "'"
    End If
    If Me.chkMeetingDate.Value = vbChecked Then     '会议日期条件
        If strwhere = "" Then
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "date > #" & Me.DTPmeetingStart.Value & _
            "# and date < #" & Me.DTPmeetingEnd.Value & "#"
    End If
    If Me.chkMeetingMaster.Value = vbChecked And _
        intMasterID > 0 Then                        '会议主持人条件
        If strwhere = "" Then
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "master=" & intMasterID
    End If
    If Me.chkMeetingPri.Value = vbChecked And _
        Me.Combo_meetingPri.Text <> "" Then         '会议重要性条件
        If strwhere = "" Then
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "Primary='" & Me.Combo_meetingPri.Text & "'"
    End If
    If Me.chkMeetingPeople.Value = vbChecked And _
        Me.txtMeetingPoeple <> "" Then              '会议相关人员条件
        If strwhere = "" Then
            strwhere = " where "
        Else
            strwhere = strwhere & " and "
        End If
        strwhere = strwhere & "people='" & Me.txtMeetingPoeple.Text & "'"
    End If
    If strwhere <> "" Then                          '设定完整查询语句
        strsql = strsql & strwhere
    End If
    rst.Open strsql, CnnDataBase, adOpenStatic      '打开数据库的记录集
    Me.MSFmeeting.Rows = 1                          '清空MSFlexGrid
    If rst.RecordCount = 0 Then                     '记录集为空，退出操作
        Exit Sub
    End If
    With Me.MSFmeeting
        Do While rst.EOF = False
            .Rows = .Rows + 1                       '增加MSFlex一行空行
            .Row = .Rows - 1
            .TextMatrix(.Row,