📄 frmaqgl.frm
字号:
VERSION 5.00
Begin VB.Form frmAqgl
BorderStyle = 1 'Fixed Single
Caption = "安全管理"
ClientHeight = 9270
ClientLeft = 45
ClientTop = 330
ClientWidth = 11085
Icon = "frmAqgl.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MDIChild = -1 'True
ScaleHeight = 9270
ScaleWidth = 11085
Begin VB.Frame Frame1
Caption = "安全管理单元"
ForeColor = &H000000FF&
Height = 8775
Left = 360
TabIndex = 0
Top = 240
Width = 10455
Begin VB.CommandButton cmdPrevious
Caption = " 上一条(&P)"
Height = 450
Left = 8640
TabIndex = 18
Top = 600
Width = 1200
End
Begin VB.CommandButton cmdUpdate
Caption = " 更 新(&U)"
Height = 450
Left = 8640
TabIndex = 17
Top = 3765
Width = 1200
End
Begin VB.CommandButton cmdNext
Caption = " 下一条(&N)"
Height = 450
Left = 8640
TabIndex = 16
Top = 2235
Width = 1200
End
Begin VB.CommandButton cmdReportView
Caption = " 生成报表(&R)"
Height = 450
Left = 8640
TabIndex = 15
Top = 5520
Width = 1250
End
Begin VB.TextBox txtActualScore
BeginProperty DataFormat
Type = 1
Format = "0"
HaveTrueFalseNull= 0
FirstDayOfWeek = 0
FirstWeekOfYear = 0
LCID = 2052
SubFormatType = 1
EndProperty
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 1920
TabIndex = 7
Top = 6380
Width = 975
End
Begin VB.TextBox txtRemark
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 1215
Left = 1920
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 6
Top = 7200
Width = 6015
End
Begin VB.TextBox txtMethod
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 1215
Left = 1920
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 5
Top = 4720
Width = 6015
End
Begin VB.TextBox txtStdScore
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 1920
Locked = -1 'True
TabIndex = 4
Top = 3900
Width = 975
End
Begin VB.TextBox txtContent
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 1215
Left = 1920
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 3
Top = 2240
Width = 6015
End
Begin VB.TextBox txtItem
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 1920
Locked = -1 'True
TabIndex = 2
Top = 1420
Width = 5895
End
Begin VB.TextBox txtClass
BeginProperty Font
Name = "宋体"
Size = 10.5
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 1920
Locked = -1 'True
TabIndex = 1
Top = 600
Width = 4695
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "考评类目："
ForeColor = &H000000FF&
Height = 180
Index = 0
Left = 720
TabIndex = 14
Top = 600
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "考评项目："
ForeColor = &H000000FF&
Height = 180
Index = 1
Left = 720
TabIndex = 13
Top = 1440
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "考评内容："
ForeColor = &H000000FF&
Height = 180
Index = 2
Left = 720
TabIndex = 12
Top = 2280
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "标准分："
ForeColor = &H000000FF&
Height = 180
Index = 3
Left = 720
TabIndex = 11
Top = 3900
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "考评办法："
ForeColor = &H000000FF&
Height = 180
Index = 4
Left = 720
TabIndex = 10
Top = 4680
Width = 900
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "实得分："
ForeColor = &H000000FF&
Height = 180
Index = 5
Left = 720
TabIndex = 9
Top = 6360
Width = 720
End
Begin VB.Label Label1
AutoSize = -1 'True
Caption = "备注："
ForeColor = &H000000FF&
Height = 180
Index = 6
Left = 720
TabIndex = 8
Top = 7200
Width = 540
End
End
End
Attribute VB_Name = "frmAqgl"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Dim RS As Recordset
'Dim UnitScore As Single
Private Sub cmdNext_Click()
RS.MoveNext
If RS.EOF Then
MsgBox "已经到记录末尾!"
RS.MoveLast
End If
txtClass = Mid(RS.Fields(0), 2)
txtItem = RS.Fields(1)
txtContent = RS.Fields(2)
txtStdScore = RS.Fields(3)
txtMethod = RS.Fields(4)
If IsNull(RS.Fields(5)) Then
txtActualScore = ""
Else
txtActualScore = RS.Fields(5)
End If
If IsNull(RS.Fields(6)) Then
txtRemark = ""
Else
txtRemark = RS.Fields(6)
End If
End Sub
Private Sub cmdPrevious_Click()
RS.MovePrevious
If RS.BOF Then
MsgBox "已经到记录头!"
RS.MoveFirst
End If
txtClass = Mid(RS.Fields(0), 2)
txtItem = RS.Fields(1)
txtContent = RS.Fields(2)
txtStdScore = RS.Fields(3)
txtMethod = RS.Fields(4)
If IsNull(RS.Fields(5)) Then
txtActualScore = ""
Else
txtActualScore = RS.Fields(5)
End If
If IsNull(RS.Fields(6)) Then
txtRemark = ""
Else
txtRemark = RS.Fields(6)
End If
End Sub
Private Sub cmdUpdate_Click()
RS.Edit
If IsNumeric(txtActualScore) Then 'And
If CInt(txtActualScore) <= RS.Fields(3) And CInt(txtActualScore) >= 0 Then
RS.Fields(5) = CInt(txtActualScore)
Else
MsgBox "输入数据超出范围!"
End If
Else
MsgBox "输入数据不是数字!或没有输入数据!"
End If
If txtRemark <> "" Then
RS.Fields(6) = txtRemark
Else
RS.Fields(6) = "无"
End If
RS.Update
End Sub
Private Sub cmdReportView_Click()
Dim ItemRS As Recordset, ClassSumRS As Recordset, TotalSumRS As Recordset, ErrEmptyRS As Recordset
Dim TempQdf As QueryDef
Dim strReport As String
'Set TempQdf = sysDB.CreateQueryDef("CommQdf")
Set TempQdf = sysDB.QueryDefs("CommQdf")
TempQdf.SQL = "Select kpClass,kpItem From AGaqglUnit Where ActualScore IS Null"
Set ErrEmptyRS = TempQdf.OpenRecordset
If Not ErrEmptyRS.BOF Then
ErrEmptyRS.MoveFirst
MsgBox "考评类目:" & ErrEmptyRS.Fields("kpClass") & "考评项目" & ErrEmptyRS.Fields("kpItem") & "，没输入分数！"
ErrEmptyRS.Close
Set ErrEmptyRS = Nothing
Exit Sub
End If
TempQdf.SQL = "Select kpClass,kpItem,StdScore,ActualScore,Remark From AGaqglUnit "
Set ItemRS = TempQdf.OpenRecordset
TempQdf.SQL = "Select kpClass,Sum(StdScore) As StdSum,Sum(ActualScore) As ActSum,Count(*) As ClassItemNum From AGaqglUnit Group By kpClass"
Set ClassSumRS = TempQdf.OpenRecordset
TempQdf.SQL = "Select Sum(StdScore) As StdTotal,Sum(ActualScore) As ActTotal From AGaqglUnit"
Set TotalSumRS = TempQdf.OpenRecordset
strReport = "考评类目" & Space(30) & "考评项目" & Space(29) & "标准分" & Space(2) & "实得分" & Space(2) & "备 注" & vbCrLf & ShortLine(100) & vbCrLf
i = 0
Do While (ItemRS.EOF = False)
'格式化输出,有汉字项空格*2作全角字符用!
strReport = strReport & Mid(ItemRS.Fields("kpClass"), 2) & Space(40 - 2 * Len(ItemRS.Fields("kpClass")))
strReport = strReport & ItemRS.Fields("kpItem") & Space(40 - 2 * Len(ItemRS.Fields("kpItem")))
strReport = strReport & ItemRS.Fields("StdScore") & Space(8 - Len(ItemRS.Fields("StdScore")))
strReport = strReport & ItemRS.Fields("ActualScore") & Space(8 - Len(ItemRS.Fields("ActualScore")))
strReport = strReport & ItemRS.Fields("Remark") & vbCrLf & vbCrLf
i = i + 1
If (i = ClassSumRS.Fields("ClassItemNum")) Then
i = 0
strReport = strReport & "小计" & Space(73) & ClassSumRS.Fields("StdSum") & Space(8 - Len(ClassSumRS.Fields("StdSum"))) & ClassSumRS.Fields("ActSum") & vbCrLf & ShortLine(100) & vbCrLf
ClassSumRS.MoveNext
End If
ItemRS.MoveNext
Loop
strReport = strReport & "总计" & Space(73) & TotalSumRS.Fields("StdTotal") & Space(8 - Len(TotalSumRS.Fields("StdTotal"))) & TotalSumRS.Fields("ActTotal") & vbCrLf 'Space(8 - Len(TotalSumRS.Fields("ActTotal"))) & vbCrLf
strReport = strReport & "报表生成时间 " & Date & " " & Time
'Debug.Print strReport
If EnterpriseRS.Fields("Name") = EnterpriseName Then
EnterpriseRS.Edit
EnterpriseRS.Fields("AqglUnitScore") = TotalSumRS.Fields("ActTotal")
EnterpriseRS.Fields("AqglUnitRep") = strReport
EnterpriseRS.Update
Else
'Debug.Print EnterpriseRS.Fields(0)
MsgBox "system errorr!"
End If
frmReportView.txtRepContent = strReport
frmReportView.Show
ItemRS.Close
Set ItemRS = Nothing
ClassSumRS.Close
Set ClassSumRS = Nothing
TotalSumRS.Close
Set TotalSumRS = Nothing
ErrEmptyRS.Close
Set ErrEmptyRS = Nothing
TempQdf.Close
Set TempQdf = Nothing
End Sub
Private Sub Form_Load()
Me.Move frmMain.ScaleWidth / 2 - Me.Width / 2, 0
bFrmShow = True 'set active flag
Set RS = sysDB.OpenRecordset("Select * From AGaqglUnit ")
If RS.BOF = True Then
MsgBox "无相关记录!"
Exit Sub
Unload Me
End If
RS.MoveFirst
txtClass = Mid(RS.Fields(0), 2)
txtItem = RS.Fields(1)
txtContent = RS.Fields(2)
txtStdScore = RS.Fields(3)
txtMethod = RS.Fields(4)
If IsNull(RS.Fields(5)) Then
txtActualScore = ""
Else
txtActualScore = RS.Fields(5)
End If
If IsNull(RS.Fields(6)) Then
txtRemark = ""
Else
txtRemark = RS.Fields(6)
End If
End Sub
Private Sub Form_Unload(Cancel As Integer)
RS.Close
Set RS = Nothing
bFrmShow = False 'Reset Flag
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -