yyzb.frm
来自「这是一个医院管理系统中的院长查询模块」· FRM 代码 · 共 440 行
FRM
440 行
VERSION 5.00
Object = "{00028C01-0000-0000-0000-000000000046}#1.0#0"; "DBGRID32.OCX"
Begin VB.Form YYZB
Caption = "医院管理综合质量统计表"
ClientHeight = 3930
ClientLeft = 1845
ClientTop = 2265
ClientWidth = 6420
ControlBox = 0 'False
BeginProperty Font
Name = "隶书"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "YYZB.frx":0000
LinkTopic = "Form8"
Moveable = 0 'False
ScaleHeight = 3930
ScaleWidth = 6420
Begin VB.CommandButton Command1
Cancel = -1 'True
Caption = "返 回&Q"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 400
Left = 9990
TabIndex = 4
Top = 330
Width = 1650
End
Begin VB.CommandButton Command2
Caption = "查 询&C"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 400
Left = 6630
TabIndex = 3
Top = 330
Width = 1650
End
Begin VB.CommandButton Command3
Caption = "打 印&P"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 400
Left = 8310
TabIndex = 2
Top = 330
Width = 1650
End
Begin VB.Data Data1
BackColor = &H00C0E0FF&
Connect = "Access"
DatabaseName = ""
DefaultCursorType= 1 'ODBCCursor
DefaultType = 1 'UseODBC
Exclusive = 0 'False
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 345
Left = 90
Options = 0
ReadOnly = 0 'False
RecordsetType = 2 'Snapshot
RecordSource = ""
Top = 8040
Width = 11685
End
Begin VB.Frame Frame1
ForeColor = &H00FF0000&
Height = 780
Left = 30
TabIndex = 1
Top = 45
Width = 11805
Begin VB.TextBox Text3
BackColor = &H00C0C0FF&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 5220
MaxLength = 8
TabIndex = 9
Top = 300
Width = 615
End
Begin VB.TextBox Text2
BackColor = &H00C0C0FF&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 4200
MaxLength = 8
TabIndex = 7
Top = 300
Width = 615
End
Begin VB.TextBox TEXT1
BackColor = &H00C0C0FF&
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 360
Left = 1980
MaxLength = 8
TabIndex = 5
Top = 300
Width = 1155
End
Begin VB.Label Label1
Caption = "至"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 330
Index = 2
Left = 4860
TabIndex = 10
Top = 330
Width = 435
End
Begin VB.Label Label1
Caption = "月份:"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 330
Index = 1
Left = 3390
TabIndex = 8
Top = 330
Width = 855
End
Begin VB.Label Label1
Caption = "查询年份:"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000FF&
Height = 330
Index = 0
Left = 510
TabIndex = 6
Top = 330
Width = 1605
End
End
Begin MSDBGrid.DBGrid DBGrid1
Bindings = "YYZB.frx":030A
Height = 7155
Left = 30
OleObjectBlob = "YYZB.frx":031A
TabIndex = 0
TabStop = 0 'False
Top = 870
Width = 11805
End
End
Attribute VB_Name = "YYZB"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Sub PRINT_1() '
Dim dd As Excel.Application
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\SB\门诊部工作情况")
dd.Range("K2").Select: dd.ActiveCell.FormulaR1C1 = " 统计区间：" + TEXT1 + "-" + Text2 + " 至 " + TEXT1 + "-" + Text3
dd.Range("I18").Select: dd.ActiveCell.FormulaR1C1 = " 制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
dd.Visible = True
xxx = 5
Do While Not Data1.Recordset.EOF
dd.Range("A" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = Left(CStr(Data1.Recordset!BB_DATE), 7)
For i = 0 To 18
MMKK = Chr(Asc("B") + i) + CStr(xxx)
dd.Range(MMKK).Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset.Fields(i).Value)
Next i
Data1.Recordset.MoveNext
xxx = xxx + 1
Loop
DDSS:
dd.Visible = True
dd.ActiveWorkbook.PrintPreview
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
End Sub
Sub PRINT_2() '
Dim dd As Excel.Application
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\SB\医院综合护理指标统计表")
dd.Range("T2").Select: dd.ActiveCell.FormulaR1C1 = " 统计区间：" + TEXT1 + "-" + Text2 + " 至 " + TEXT1 + "-" + Text3
dd.Range("R17").Select: dd.ActiveCell.FormulaR1C1 = " 制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
dd.Visible = True
xxx = 6
Do While Not Data1.Recordset.EOF
For i = 0 To 25
MMKK = Chr(Asc("A") + i) + CStr(xxx)
dd.Range(MMKK).Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset.Fields(i).Value)
Next i
Data1.Recordset.MoveNext
xxx = xxx + 1
Loop
DDSS:
dd.Visible = True
dd.ActiveWorkbook.PrintPreview
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
End Sub
Sub PRINT_3() '
Dim dd As Excel.Application
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\SB\医院管理综合质量统计表")
dd.Range("P2").Select: dd.ActiveCell.FormulaR1C1 = " 统计区间：" + TEXT1 + "-" + Text2 + " 至 " + TEXT1 + "-" + Text3
dd.Range("M19").Select: dd.ActiveCell.FormulaR1C1 = " 制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
dd.Visible = True
xxx = 7
Do While Not Data1.Recordset.EOF
dd.Range("A" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = Left(CStr(Data1.Recordset!BB_DATE), 7)
For i = 0 To 18
MMKK = Chr(Asc("B") + i) + CStr(xxx)
dd.Range(MMKK).Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset.Fields(i).Value)
Next i
Data1.Recordset.MoveNext
xxx = xxx + 1
Loop
DDSS:
dd.Visible = True
dd.ActiveWorkbook.PrintPreview
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
End Sub
Private Sub Command3_Click()
Data1.Refresh
If Data1.Recordset.EOF Then
Exit Sub
End If
If Me.Tag = "1" Then
PRINT_1
End If
If Me.Tag = "2" Then
PRINT_2
End If
If Me.Tag = "3" Then
PRINT_3
End If
End Sub
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
If Val(TEXT1) > 2100 Or Val(TEXT1) < 1900 Then
TEXT1.SetFocus
Exit Sub
End If
If Val(Text2) < 1 Or Val(Text2) > 12 Then
Text2.SetFocus
Exit Sub
End If
If Val(Text3) < 1 Or Val(Text3) > 12 Then
Text3.SetFocus
Exit Sub
End If
If Val(Text2) > Val(Text3) Then
Text2.SetFocus
Exit Sub
End If
DATE1 = CDate(TEXT1 + "-" + Text2 + "-25")
DATE2 = CDate(TEXT1 + "-" + Text3 + "-25")
If Me.Tag = "1" Then
DDS = "SELECT 实有观察床数,观察病床工作日,各级医师门诊工作总日数,门诊手术次数,处置次数,检验总件数,医疗事故发生数,门诊人次数,急诊人次数,体检人数,抢救人数,抢救脱险人数,死亡人数,* FROM BA_ZB1 WHERE BB_DATE<='" + CStr(DATE2) + "' AND BB_DATE>='" + CStr(DATE1) + "'" ' ORDER BY KS_ID"
End If
If Me.Tag = "2" Then
DDS = "SELECT 科室名称,AVG(病区管理合格率) AS 病区管理_合格率,AVG(护理技术操作合格率) AS 护理技术操作_合格率," + _
"AVG(基础护理合格率) AS 基础护理_合格率,SUM(特护人数) AS 特护_人次,SUM(一级护理人次) AS 一级护理_人次," + _
"AVG(特护一级护理合格率) AS 特护一级护理_合格率,SUM(整体护理人次) AS 整体护理_人次,AVG(护理计划合格率) AS 护理计划_合格率," + _
"AVG(五种护理表格书写合格率) AS 五种护理表格书写_合格率,SUM(护理差错发生数) AS 护理差错_发生数," + _
"AVG(护理差错发生率) AS 护理差错_发生率,SUM(褥疮发生数) AS 褥疮_发生数,AVG(褥疮发生率) AS 褥疮_发生率," + _
"AVG(陪护率) AS 陪护_率,AVG(急救物品完好率) AS 急救物品_完好率,AVG(常规物品消毒灭菌合格率) AS 常规物品消毒灭菌_合格率," + _
"SUM(输血反应人次) AS 输血反应_人次,AVG(输血反应率) AS 输血_反应率,SUM(输液反应人次) AS 输液_反应人次," + _
"AVG(输液反应率) AS 输液_反应率,SUM(加床病人数) AS 加床_病人数,SUM(空床数) AS 空床_数," + _
"AVG(三级事故发生率) AS 三级事故_发生率,SUM(二级事故发生数) AS 二级事故_发生数," + _
"SUM(一级事故发生数) AS 一级事故_发生数,AVG(YYYP) AS 一人一针一普合格率,KS_ID FROM BA_ZB2 WHERE BB_DATE<='" + CStr(DATE2) + "' AND BB_DATE>='" + CStr(DATE1) + "' GROUP BY KS_ID,科室名称 ORDER BY KS_ID"
End If
If Me.Tag = "3" Then
DDS = "SELECT * FROM BA_ZB3 WHERE BB_DATE<='" + CStr(DATE2) + "' AND BB_DATE>='" + CStr(DATE1) + "'"
End If
Data1.RecordSource = DDS
Data1.Refresh
End Sub
Private Sub Form_Activate()
Call Command2_Click
TEXT1.SetFocus
End Sub
Private Sub Form_Load()
Data1.Connect = DxPassWord
Data1.DatabaseName = "207his"
Me.Top = 0
Me.Left = 0
Me.Width = Screen.Width
Me.Height = Screen.Height
TEXT1 = Year(Date)
Text2 = "01"
Text3 = "12"
End Sub
Private Sub Form_Resize()
On Error GoTo dde
Me.Top = 0
Me.Left = 0
Me.Width = Screen.Width
Me.Height = Screen.Height
dde:
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form3.Enabled = True
End Sub
Private Sub Text1_GotFocus()
TEXT1.SelStart = 0
TEXT1.SelLength = Len(TEXT1)
End Sub
Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Text2.SetFocus
End If
End Sub
Private Sub Text1_LostFocus()
Text2 = "01"
Text3 = "12"
End Sub
Private Sub Text2_GotFocus()
Text2.SelStart = 0
Text2.SelLength = Len(Text2)
End Sub
Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Text3.SetFocus
End If
End Sub
Private Sub Text3_GotFocus()
Text3.SelStart = 0
Text3.SelLength = Len(Text3)
End Sub
Private Sub Text3_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Command2.SetFocus
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?