bltj.frm

这是一个医院管理系统中的院长查询模块

Sub PRINT_1() '疾病手术情况统计表
Dim dd As Excel.Application
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\SB\疾病手术情况统计表")
dd.Range("L2").Select: dd.ActiveCell.FormulaR1C1 = " 统计日期：" + CStr(DATE1) + " 至 " + DATE2
yyy = 1
dd.Range("I26").Select: dd.ActiveCell.FormulaR1C1 = "第" + CStr(yyy) + "页  " + Data1.Caption + "        制 表：" + 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 = Trim(Data1.Recordset!疾病名称)
dd.Range("B" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅰ_甲)
dd.Range("C" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅰ_乙)
dd.Range("D" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅰ_丙)
dd.Range("E" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅱ_甲)
dd.Range("F" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅱ_乙)
dd.Range("G" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅱ_丙)
dd.Range("H" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅲ_甲)
dd.Range("I" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅲ_乙)
dd.Range("J" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!Ⅲ_丙)
dd.Range("L" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!手术人数)
dd.Range("M" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!手术并发症人数)
dd.Range("O" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!手术前住院总日数)
dd.Range("P" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!平均术前住院日)
Data1.Recordset.MoveNext
xxx = xxx + 1
If xxx > 25 Then
dd.ActiveWorkbook.PrintPreview
yyy = yyy + 1
dd.Range("I26").Select: dd.ActiveCell.FormulaR1C1 = "第" + CStr(yyy) + "页  " + Data1.Caption + "        制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
xxx = 5
End If
Loop
DDSS:
dd.Visible = True
If xxx <> 5 Then
dd.ActiveWorkbook.PrintPreview
End If
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("K2").Select: dd.ActiveCell.FormulaR1C1 = " 统计日期：" + CStr(DATE1) + " 至 " + DATE2
yyy = 1
dd.Range("H26").Select: dd.ActiveCell.FormulaR1C1 = "第" + CStr(yyy) + "页  " + Data1.Caption + "        制 表：" + 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 = Trim(Data1.Recordset!疾病名称)
dd.Range("B" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!手术出院人数)
dd.Range("C" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!手术前后诊断符合数)
dd.Range("D" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!手术前后诊断不符数)
dd.Range("E" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!手术前后无对照数)
dd.Range("G" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!X线_术后诊断符合数)
dd.Range("H" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!X线_术后诊断不符数)
dd.Range("I" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!X线_术后诊断无对照数)
dd.Range("K" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!临床_病理诊断符合数)
dd.Range("L" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!临床_病理诊断不符数)
dd.Range("M" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!临床_病理诊断无对照数)
Data1.Recordset.MoveNext
xxx = xxx + 1
If xxx > 25 Then
dd.ActiveWorkbook.PrintPreview
yyy = yyy + 1
dd.Range("H26").Select: dd.ActiveCell.FormulaR1C1 = "第" + CStr(yyy) + "页  " + Data1.Caption + "        制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
xxx = 5
End If
Loop
DDSS:
dd.Visible = True
If xxx <> 5 Then
dd.ActiveWorkbook.PrintPreview
End If
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
End Sub
Sub PRINT_4() '疾病治疗质量、治疗服务量统计表
Dim dd As Excel.Application
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\SB\疾病治疗质量、治疗服务量统计表")
dd.Range("L2").Select: dd.ActiveCell.FormulaR1C1 = " 统计日期：" + CStr(DATE1) + " 至 " + DATE2
yyy = 1
dd.Range("I27").Select: dd.ActiveCell.FormulaR1C1 = "第" + CStr(yyy) + "页  " + Data1.Caption + "        制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
dd.Visible = True
xxx = 6
Do While Not Data1.Recordset.EOF
dd.Range("A" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = Trim(Data1.Recordset!疾病名称)
dd.Range("E" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!出院者平均住院日)
dd.Range("F" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!治愈者平均住院日)
dd.Range("I" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!治愈人数)
dd.Range("J" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!好转人数)
dd.Range("K" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!未愈人数)
dd.Range("L" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!死亡人数)
dd.Range("M" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!其它未治人数)
dd.Range("N" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!出院者住院总日数)
dd.Range("O" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!治愈者住院总日数)
Data1.Recordset.MoveNext
xxx = xxx + 1
If xxx > 26 Then
dd.ActiveWorkbook.PrintPreview
yyy = yyy + 1
dd.Range("I27").Select: dd.ActiveCell.FormulaR1C1 = "第" + CStr(yyy) + "页  " + Data1.Caption + "        制 表：" + Form3.sbar.Panels(2) + " " + CStr(Date) + " " + CStr(Time)
xxx = 6
End If
Loop
DDSS:
dd.Visible = True
If xxx <> 6 Then
dd.ActiveWorkbook.PrintPreview
End If
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
End Sub
Sub PRINT_5() '卫生部门医院住院病人疾病分类年报表
Dim dd As Excel.Application
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\SB\卫生部门医院住院病人疾病分类年报表")
dd.Range("C2").Select: dd.ActiveCell.FormulaR1C1 = CStr(Year(DATE1)) + " 年"
yyy = 1
dd.Visible = True
xxx = 8
Do While Not Data1.Recordset.EOF
If yyy = 1 Then
dd.Range("B" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = Trim(Data1.Recordset!出院总人数)
dd.Range("D" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!治愈人数)
dd.Range("E" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!好转人数)
dd.Range("F" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!未愈人数)
dd.Range("G" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!死亡人数)
dd.Range("H" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!出院者住院总日数)
Else
dd.Range("J" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = Trim(Data1.Recordset!出院总人数)
dd.Range("L" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!治愈人数)
dd.Range("M" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!好转人数)
dd.Range("N" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!未愈人数)
dd.Range("O" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!死亡人数)
dd.Range("P" + CStr(xxx) + "").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(Data1.Recordset!出院者住院总日数)
End If
Data1.Recordset.MoveNext
xxx = xxx + 1
If xxx = 36 Then
If yyy = 1 Then
yyy = 2
xxx = 8
Else
yyy = 1
xxx = 44
End If
End If
If xxx = 72 Then
If yyy = 1 Then
yyy = 2
xxx = 44
Else
yyy = 1
xxx = 80
End If
End If
If xxx = 108 Then
If yyy = 1 Then
yyy = 2
xxx = 80
Else
yyy = 1
xxx = 107
End If
End If
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
If Me.Tag = "4" Then
PRINT_4
End If
If Me.Tag = "5" Then
PRINT_5
End If
End Sub
Private Sub Command1_Click()
Unload Me
End Sub

Private Sub Command2_Click()
If IsDate(DATE1) And IsDate(DATE2) Then
MsgBox "统计数据需要几分钟时间,请您按确定后.等待...", , "请等待"
DDS = "BA_JBFL '" + Me.Tag + "','" + TEXT1 + "','" + CStr(DATE1) + "','" + CStr(DATE2) + "'"
Data1.RecordSource = DDS
Data1.Refresh
If Me.Tag <> "5" Then
If Not Data1.Recordset.EOF Then
Data1.Recordset.MoveLast
DDSS = Data1.Recordset.RecordCount
Data1.Recordset.MoveFirst
Data1.Caption = "( 共：" + CStr(Int((DDSS + 20) / 21)) + " 页 )"
End If
End If
End If
End Sub

Private Sub date1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And IsDate(DATE1) Then
DATE2.SetFocus
End If
End Sub

Private Sub date2_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 And IsDate(DATE2) And IsDate(DATE1) Then
Command2_Click
End If
End Sub
Private Sub date2_GotFocus()
DATE2.SelStart = 0
DATE2.SelLength = Len(DATE2)
End Sub

Private Sub Form_Activate()
If Me.Tag <> "5" Then
Call Command2_Click
End If
DATE1.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 = "01"
DATE1 = DateAdd("m", -1, Date)
DATE2 = Date
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 date1_GotFocus()
DATE1.SelStart = 0
DATE1.SelLength = Len(DATE1)
End Sub

Private Sub Text1_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = 13 Then
Command2_Click
End If
End Sub