📄 mainmdiform.frm

📁 针对矿山企业安全相关法律开发的企业考核评价系统
💻 FRM
📖 第 1 页 / 共 2 页
字号:
上一页 12
If bFrmShow = False Then
    FrmPublic.TableName = "DCfpshUnit"
    FrmPublic.Caption = "地采系统"
    FrmPublic.Frame1.Caption = "防排水单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuDCkshjxUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "DCkshjxUnit"
    FrmPublic.Caption = "地采系统"
    FrmPublic.Frame1.Caption = "矿山井巷单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuDCtffchUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "DCtffchUnit"
    FrmPublic.Caption = "地采系统"
    FrmPublic.Frame1.Caption = "通风防尘单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuDCtshyshUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "DCtshyshUnit"
    FrmPublic.Caption = "地采系统"
    FrmPublic.Frame1.Caption = "提升运输单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuExit_Click()
   Unload Me
End Sub

Private Sub mnuHelpContent_Click()
    MsgBox "请查看安装目录下的帮助文档！", vbInformation, "帮助主题"
End Sub

Private Sub mnuLCbpglUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "LCbpglUnit"
    FrmPublic.Caption = "露采系统"
    FrmPublic.Frame1.Caption = "边坡管理单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuLCfpshUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "LCfpshUnit"
    FrmPublic.Caption = "露采系统"
    FrmPublic.Frame1.Caption = "防排水单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuLCgdUint_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "LCgdUnit"
    FrmPublic.Caption = "露采系统"
    FrmPublic.Frame1.Caption = "供电单元"
    FrmPublic.Show
    Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuLCltcchUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "LCltcchUnit" '//此语句必须放在最前,否则 FORM_LOAD 过程得不到最新值,其它类同
    FrmPublic.Caption = "露采系统"
    FrmPublic.Frame1.Caption = "露天采场单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuLCptchUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "LCptchUnit"
    FrmPublic.Caption = "露采系统"
    FrmPublic.Frame1.Caption = "排土场单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub

Private Sub mnuLCyshUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "LCyshUnit"
    FrmPublic.Caption = "露采系统"
    FrmPublic.Frame1.Caption = "运输单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub



Private Sub mnuNewKP_Click()
Dim tempName As String
    If EnterpriseName <> "" Then
        If (MsgBox("您要关闭当前考评吗？", vbOKCancel) = vbOK) Then
            Call CloseKP
        Else
            Exit Sub
        End If
    End If
    tempName = InputBox("请输入被考评企业的名称：")
    If tempName <> "" Then '0
        If (MsgBox("您输入的企业名称为: " & tempName, vbOKCancel + vbInformation, "信息确认") = vbOK) Then '1
            EnterpriseName = tempName
            Set EnterpriseRS = sysDB.OpenRecordset("Select * From Enterprise ")
            ErsOpened = True
            If EnterpriseRS.BOF Then '2表为空
                EnterpriseRS.AddNew
                EnterpriseRS.Fields("Name") = EnterpriseName
                EnterpriseRS.Update
                EnterpriseRS.MoveLast '定位使之成为当前记录
            Else
                EnterpriseRS.FindFirst "Name='" & EnterpriseName & " '"
                If EnterpriseRS.NoMatch Then '3
                    EnterpriseRS.AddNew
                    EnterpriseRS.Fields("Name") = EnterpriseName
                    EnterpriseRS.Update
                    EnterpriseRS.MoveLast
                    If (MsgBox("是否删除原有考评数据？", vbYesNo + vbQuestion) = vbYes) Then
                        Call InitDataBase
                    End If
                Else
                    MsgBox "该企企业的考评已经存在，您可以在原有基础上修改！"
                End If '3
            End If '2
            mnuAQGL.Enabled = True
            mnuLCXT.Enabled = True
            mnuDCXT.Enabled = True
            mnuWKK.Enabled = True
            Me.Caption = "矿山企业考评系统" & "[ " & EnterpriseName & " ]"
            'MsgBox "您可以开始考评了！"
        Else 'vbcancel
            MsgBox "  操作被取消！"
            
        End If '1
    Else 'input cancel
        MsgBox "没有正确输入企业名称或操作被取消！"
    End If '0
End Sub

Private Sub mnuOpenKP_Click()
    If EnterpriseName <> "" Then
        If (MsgBox("您要关闭当前考评吗？", vbOKCancel) = vbOK) Then
            Call CloseKP
        Else
            Exit Sub
        End If
    End If
    OpenKPDialog.Show 1
End Sub

Private Sub mnuReportOutput_Click()
'Toolbar1.Buttons("kpRepSaveAs").Enabled = True
'Toolbar1.Buttons("kpRepPrint").Enabled = True
frmRepOutput.Show
End Sub

Private Sub mnuWKwkuUnit_Click()
If bFrmShow = False Then
    FrmPublic.TableName = "WKwkuUnit"
    FrmPublic.Caption = "尾矿库"
    FrmPublic.Frame1.Caption = "尾矿库单元"
    FrmPublic.Show
Else
    MsgBox "请先完成或关闭当前单元的评审！"
End If
End Sub


Private Sub CloseKP()
    EnterpriseName = ""
    frmMain.Caption = "矿山企业考评系统" & "[ ]"
    If bFrmShow = True Then
        Unload frmMain.ActiveForm
    End If
         mnuAQGL.Enabled = False
         mnuLCXT.Enabled = False
         mnuDCXT.Enabled = False
         mnuWKK.Enabled = False
End Sub

Private Sub InitDataBase()
Dim myRS As Recordset
Set myRS = sysDB.OpenRecordset("Select ActualScore,Remark from AGaqglUnit") '1
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from LCltcchUnit") '2
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from LCbpglUnit") '3
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from LCyshUnit") '4
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from LCgdUnit") '5
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from LCfpshUnit") '6
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from LCptchUnit") '7
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
  
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from DCkshjxUnit") '8
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from DCdxkcUnit") '9
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from DCtshyshUnit") '10
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from DCtffchUnit") '11
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from DCdqshbUnit") '12
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from DCfpshUnit") '13
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from DCfmhUnit") '14
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = sysDB.OpenRecordset("Select NotInclude,ActualScore,Remark from WKwkuUnit") '15
Do While Not myRS.EOF
    myRS.Edit
    myRS.Fields("NotInclude") = False
    myRS.Fields("ActualScore") = Null
    myRS.Fields("Remark") = Null
    myRS.Update
    myRS.MoveNext
Loop
myRS.Close
Set myRS = Nothing
End Sub

Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
    Select Case Button.Key
    Case "kpNew"
         Call mnuNewKP_Click
    Case "kpOpen"
         Call mnuOpenKP_Click
    Case "kpReport"
        Call mnuReportOutput_Click
    End Select
        
End Sub
上一页 12
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -