📄 frmrepoutput.frm
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmRepOutput
Caption = "报表输出"
ClientHeight = 8595
ClientLeft = 60
ClientTop = 345
ClientWidth = 11880
Icon = "frmRepOutput.frx":0000
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 8595
ScaleWidth = 11880
Begin VB.ComboBox ComboEName
Height = 300
Left = 0
Style = 2 'Dropdown List
TabIndex = 2
ToolTipText = "请选择或输入企业名称"
Top = 960
Width = 2055
End
Begin VB.TextBox txtReport
ForeColor = &H00FF0000&
Height = 8655
Left = 2160
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 1
Top = 960
Width = 11175
End
Begin MSComctlLib.TreeView TreeView1
Height = 6975
Left = 0
TabIndex = 0
Top = 1440
Width = 2055
_ExtentX = 3625
_ExtentY = 12303
_Version = 393217
LabelEdit = 1
LineStyle = 1
Style = 7
Appearance = 1
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "企业名称："
Height = 180
Left = 0
TabIndex = 3
Top = 600
Width = 900
End
End
Attribute VB_Name = "frmRepOutput"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub ComboEName_Click()
EnterpriseRS.FindFirst "Name='" & ComboEName.Text & "'"
TreeView1.Refresh
End Sub
Private Sub Form_Load()
Dim mynode As Node
Set mynode = TreeView1.Nodes.Add(, , "AQGL", "安全管理")
Set mynode = TreeView1.Nodes.Add("AQGL", tvwChild, "aqglUnit", "安全管理单元")
Set mynode = TreeView1.Nodes.Add(, , "LCXT", "露采系统")
Set mynode = TreeView1.Nodes.Add("LCXT", tvwChild, "LCltcchUnit", "露天采场单元")
Set mynode = TreeView1.Nodes.Add("LCXT", tvwChild, "LCbpglUnit", "边坡管理单元")
Set mynode = TreeView1.Nodes.Add("LCXT", tvwChild, "LCyshUnit", "运输单元")
Set mynode = TreeView1.Nodes.Add("LCXT", tvwChild, "LCgdUnit", "供电单元")
Set mynode = TreeView1.Nodes.Add("LCXT", tvwChild, "LCfpshUnit", "防排水单元")
Set mynode = TreeView1.Nodes.Add("LCXT", tvwChild, "LCptchUnit", "排土场单元")
Set mynode = TreeView1.Nodes.Add(, , "DCXT", "地采系统")
Set mynode = TreeView1.Nodes.Add("DCXT", tvwChild, "DCkshjxUnit", "矿山井巷单元")
Set mynode = TreeView1.Nodes.Add("DCXT", tvwChild, "DCdxkcUnit", "地下开采单元")
Set mynode = TreeView1.Nodes.Add("DCXT", tvwChild, "DCtshyshUnit", "提升运输单元")
Set mynode = TreeView1.Nodes.Add("DCXT", tvwChild, "DCtffchUnit", "通风防尘单元")
Set mynode = TreeView1.Nodes.Add("DCXT", tvwChild, "DCdqshbUnit", "电气设备单元")
Set mynode = TreeView1.Nodes.Add("DCXT", tvwChild, "DCfpshUnit", "防排水单元")
Set mynode = TreeView1.Nodes.Add("DCXT", tvwChild, "DCfmhUnit", "防灭火单元")
Set mynode = TreeView1.Nodes.Add(, , "WKU", "尾矿库")
Set mynode = TreeView1.Nodes.Add("WKU", tvwChild, "WKwkuUnit", "尾矿库单元")
Set mynode = TreeView1.Nodes.Add(, , "XTZP", "系统综评")
'ComboEName.Text = "请选择或输入企业名称"
Set EnterpriseRS = sysDB.OpenRecordset("Select * From Enterprise")
ErsOpened = True
If EnterpriseRS.BOF Then
MsgBox "没有报表可以输出!"
TreeView1.Enabled = False ' firbid
Else
Do While Not EnterpriseRS.EOF
ComboEName.AddItem EnterpriseRS.Fields("Name")
EnterpriseRS.MoveNext
Loop
ComboEName.ListIndex = 0
EnterpriseRS.MoveFirst
End If
End Sub
Private Sub Form_Resize()
Label1.Top = 0
Label1.Left = 0
ComboEName.Top = Label1.Height
ComboEName.Left = 0
ComboEName.Width = Me.ScaleWidth / 4
TreeView1.Top = ComboEName.Height + Label1.Height + 100
TreeView1.Left = 0
TreeView1.Width = Me.ScaleWidth / 4
TreeView1.Height = IIf((Me.ScaleHeight - ComboEName.Height) > 500, Me.ScaleHeight - ComboEName.Height - 500, 500)
txtReport.Top = ComboEName.Top
txtReport.Left = ComboEName.Width + 50
txtReport.Width = Me.ScaleWidth - ComboEName.Width
txtReport.Height = TreeView1.Height + ComboEName.Height
End Sub
Private Sub Form_Unload(Cancel As Integer)
'frmMain.Toolbar1.Buttons("kpRepSaveAs").Enabled = False
'frmMain.Toolbar1.Buttons("kpRepPrint").Enabled = False
End Sub
Private Sub TreeView1_NodeClick(ByVal Node As MSComctlLib.Node)
If Right(CStr(Node.Key), 4) = "Unit" Then
txtReport.Text = Space(30) & ComboEName.Text & Node.Parent.Text & Node.Text & "报表" & vbCrLf & vbCrLf & IIf(IsNull(EnterpriseRS.Fields(CStr(Node.Key) & "Rep")), "空", EnterpriseRS.Fields(CStr(Node.Key) & "Rep"))
Else
If CStr(Node.Key) = "XTZP" Then
Call SYSZP
End If
End If
End Sub
Private Sub SYSZP()
Dim strX As String, strAG As String, strLC As String, strDC As String, strWK As String
Dim NullFlag As Boolean, LCScore As Single, DCScore As Single '///
Dim index As Integer
If IsNull(EnterpriseRS.Fields("AqglUnitScore")) Then '//没有完成评价
strAG = "安全管理考评未完成" & vbCrLf & vbCrLf
strAG = strAG & Space(4) & "安全管理单元得分 " & "Null"
Else
Select Case EnterpriseRS.Fields("AqglUnitScore")
Case Is >= 90
strAG = "安全管理" & Space(12) & "一级安全管理" & " 得分 " & EnterpriseRS.Fields("AqglUnitScore") & vbCrLf & vbCrLf
Case Is >= 80
strAG = "安全管理" & Space(12) & "二级安全管理" & " 得分 " & EnterpriseRS.Fields("AqglUnitScore") & vbCrLf & vbCrLf
Case Is >= 70
strAG = "安全管理" & Space(12) & "三级安全管理" & " 得分 " & EnterpriseRS.Fields("AqglUnitScore") & vbCrLf & vbCrLf
Case Else
strAG = "安全管理" & Space(12) & "安全管理不达标" & " 得分 " & EnterpriseRS.Fields("AqglUnitScore") & vbCrLf & vbCrLf
End Select
strAG = strAG & Space(4) & "安全管理单元得分 " & EnterpriseRS.Fields("AqglUnitScore")
End If
'///////////////////////////////////////////////////
NullFlag = False
For index = 3 To 13 Step 2
If IsNull(EnterpriseRS.Fields(index)) Then
NullFlag = True
Exit For
End If
Next index
If NullFlag = True Then '//没有完成评价
strLC = "露采系统考评未完成或未参与评价"
Else
'6．露天采场单元、边坡管理单元、运输单元、供电单元、防排水单元和排土场单元的权重系数
'分别为0.40、0.15、0.15、0.10、0.10和0.10。
LCScore = EnterpriseRS.Fields("LCltcchUnitScore") * 0.4 _
+ EnterpriseRS.Fields("LCbpglUnitScore") * 0.15 _
+ EnterpriseRS.Fields("LCyshUnitScore") * 0.15 _
+ EnterpriseRS.Fields("LCgdUnitScore") * 0.1 _
+ EnterpriseRS.Fields("LCfpshUnitScore") * 0.1 _
+ EnterpriseRS.Fields("LCptchUnitScore") * 0.1
If LCScore >= 90 Then
strLC = "露采系统" & Space(12) & "一级露天开采系统" & " 得分 " & LCScore
ElseIf LCScore >= 80 Then
strLC = "露采系统" & Space(12) & "二级露天开采系统" & " 得分 " & LCScore
ElseIf LCScore >= 70 Then
strLC = "露采系统" & Space(12) & "三级露天开采系统" & " 得分 " & LCScore
Else
strLC = "露采系统" & Space(12) & "不达标露天开采系统" & " 得分 " & LCScore
End If
End If
strLC = strLC & vbCrLf & vbCrLf & Space(4) & "露天采场单元得分 " & EnterpriseRS.Fields("LCltcchUnitScore")
strLC = strLC & vbCrLf & vbCrLf & Space(4) & "边坡管理单元得分 " & EnterpriseRS.Fields("LCbpglUnitScore")
strLC = strLC & vbCrLf & vbCrLf & Space(4) & "运输单元得分 " & EnterpriseRS.Fields("LCyshUnitScore")
strLC = strLC & vbCrLf & vbCrLf & Space(4) & "供电单元得分 " & EnterpriseRS.Fields("LCgdUnitScore")
strLC = strLC & vbCrLf & vbCrLf & Space(4) & "防排水单元得分 " & EnterpriseRS.Fields("LCfpshUnitScore")
strLC = strLC & vbCrLf & vbCrLf & Space(4) & "排土场单元得分 " & EnterpriseRS.Fields("LCptchUnitScore")
'／／／／／／／／／／／／／／／／／／／／／／
NullFlag = False
For index = 15 To 27 Step 2
If IsNull(EnterpriseRS.Fields(index)) Then
NullFlag = True
Exit For
End If
Next index
If NullFlag = True Then '//没有完成评价
strDC = "地采系统考评未完成或未参与评价"
Else
'5. 矿山井巷单元、地下开采单元、提升运输单元、通风防尘单元、电气设备单元、防排水单元和防灭火单元的
'权重系数分别为0.20、0.25、0.20、0.10、0.10、0.10和0.05。
DCScore = EnterpriseRS.Fields(15) * 0.2 _
+ EnterpriseRS.Fields(17) * 0.25 _
+ EnterpriseRS.Fields(19) * 0.2 _
+ EnterpriseRS.Fields(21) * 0.1 _
+ EnterpriseRS.Fields(23) * 0.1 _
+ EnterpriseRS.Fields(25) * 0.1 _
+ EnterpriseRS.Fields(27) * 0.05
If DCScore >= 90 Then
strDC = "地采系统" & Space(12) & "一级地下开采系统" & " 得分 " & DCScore
ElseIf DCScore >= 80 Then
strDC = "地采系统" & Space(12) & "二级地下开采系统" & " 得分 " & DCScore
ElseIf DCScore >= 70 Then
strDC = "地采系统" & Space(12) & "三级地下开采系统" & " 得分 " & DCScore
Else
strDC = "地采系统" & Space(12) & "不达标地下开采系统" & " 得分 " & DCScore
End If
End If
strDC = strDC & vbCrLf & vbCrLf & Space(4) & "矿山井巷单元得分 " & EnterpriseRS.Fields(15)
strDC = strDC & vbCrLf & vbCrLf & Space(4) & "地下开采单元得分 " & EnterpriseRS.Fields(17)
strDC = strDC & vbCrLf & vbCrLf & Space(4) & "提升运输单元得分 " & EnterpriseRS.Fields(19)
strDC = strDC & vbCrLf & vbCrLf & Space(4) & "通风防尘单元得分 " & EnterpriseRS.Fields(21)
strDC = strDC & vbCrLf & vbCrLf & Space(4) & "电气设备单元得分 " & EnterpriseRS.Fields(23)
strDC = strDC & vbCrLf & vbCrLf & Space(4) & "防排水单元得分 " & EnterpriseRS.Fields(25)
strDC = strDC & vbCrLf & vbCrLf & Space(4) & "防灭火单元得分 " & EnterpriseRS.Fields(27)
'////////////////////////////////////////////////////////////////////////////////////////////////
If IsNull(EnterpriseRS.Fields("WKwkuUnitScore")) Then '//没有完成评价
strWK = "尾矿库考评未完成" & vbCrLf & vbCrLf
strWK = strWK & Space(4) & "尾矿库单元得分 " & "Null"
Else
Select Case EnterpriseRS.Fields("WKwkuUnitScore")
Case Is >= 90
strWK = "尾矿库" & Space(14) & "一级尾矿库" & " 得分 " & EnterpriseRS.Fields("WKwkuUnitScore") & vbCrLf & vbCrLf
Case Is >= 80
strWK = "尾矿库" & Space(14) & "二级尾矿库" & " 得分 " & EnterpriseRS.Fields("WKwkuUnitScore") & vbCrLf & vbCrLf
Case Is >= 70
strWK = "尾矿库" & Space(14) & "三级尾矿库" & " 得分 " & EnterpriseRS.Fields("WKwkuUnitScore") & vbCrLf & vbCrLf
Case Else
strWK = "尾矿库" & Space(14) & "不达标尾矿库" & " 得分 " & EnterpriseRS.Fields("WKwkuUnitScore") & vbCrLf & vbCrLf
End Select
strWK = strWK & Space(4) & "尾矿库单元得分 " & EnterpriseRS.Fields("WKWKUUnitScore")
End If
Me.txtReport.Text = Space(30) & ComboEName.Text & "系统综合报表" & vbCrLf & vbCrLf
Me.txtReport.Text = txtReport & strAG & vbCrLf & vbCrLf & strLC & vbCrLf & vbCrLf & strDC & vbCrLf & vbCrLf & strWK
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -