📄 module2.bas

📁 这是一个医院管理系统中的院长查询模块
💻 BAS
📖 第 1 页 / 共 5 页
字号:
上一页 1 2 3 45
F_HJ = F_HJ - 1
P_PAGE = (F_HJ + 5) \ 6
If P_PAGE = F_HJ / 6 Then
P_PAGE = P_PAGE + 1
End If
KSID(P_PAGE * 6) = "99"
KSNAME(P_PAGE * 6) = "合   计"
Set dd = CreateObject("Excel.Application")
dd.Workbooks.Open ("C:\PP\MZRB")
j = 1
If CDate(DATE1) = CDate("2000-01-01") Then
DATE1 = "    -  -  "
End If
For KK = 1 To P_PAGE
If DATEB - DATEA > 60 Then
Set d1 = db.OpenRecordset("SELECT SUM(MZ_LC+CF_LC) AS HJ1,SUM(HJ_MONEY) AS HJ FROM MZ_RB WHERE RB_DATE>CDATE('" + CStr(DateAdd("YYYY", -1, DATEA)) + "') AND RB_DATE<=CDATE('" + CStr(DateAdd("YYYY", -1, DATEB)) + "')")
If IsNull(d1!HJ) Then
SCHJ1 = 0
SCHJ = 0
Else
SCHJ1 = d1!hj1
SCHJ = d1!HJ
End If
d1.Close
dd.Range("A1").Select: dd.ActiveCell.FormulaR1C1 = " " + CStr(DATEB) + "爱龄奇医院门诊收入年报表（" + CStr(P_PAGE) + "." + CStr(KK) + "）"
Else
Set d1 = db.OpenRecordset("SELECT SUM(MZ_LC+CF_LC) AS HJ1,SUM(HJ_MONEY) AS HJ FROM MZ_RB WHERE RB_DATE>CDATE('" + CStr(DateAdd("M", -1, DATEA)) + "') AND RB_DATE<=CDATE('" + CStr(DateAdd("M", -1, DATEB)) + "')")
If IsNull(d1!HJ) Then
SCHJ1 = 0
SCHJ = 0
Else
SCHJ1 = d1!hj1
SCHJ = d1!HJ
End If
d1.Close
dd.Range("A1").Select: dd.ActiveCell.FormulaR1C1 = " " + CStr(DATEB) + "爱龄奇医院门诊收入月报表（" + CStr(P_PAGE) + "." + CStr(KK) + "）"
End If
dd.Range("B2").Select: dd.ActiveCell.FormulaR1C1 = "统计日期[" + Left(CStr(time1), 10) + "]统计时间[" _
+ Right(CStr(time1), 8) + "]数据期间[" + Left(CStr(DATE1), 10) + "至" + Left(CStr(DATE2), 10) + _
"] 门诊量次[" + CStr(LCS) + "]，冲方量次[" + CStr(CFLCS) + "]，冲方金额[" + CStr(CFJES) + "]      打印日期[" + CStr(Date) + "]"
dd.Range("B39").Select: dd.ActiveCell.FormulaR1C1 = ""
For i = Asc("C") To Asc("M") Step 2
mm = Chr(i) + "3:" + Chr(i + 1) + "3"
dd.Range(mm).Select: dd.ActiveCell.FormulaR1C1 = KSNAME(j)
j = j + 1
If KSID(j - 1) = "99" Then
SSSM = "SUM(A1) AS AA1,SUM(B1) AS BB1"
For G = 2 To 24
SSSM = SSSM + ",SUM(A" + CStr(G) + ") AS AA" + CStr(G)
SSSM = SSSM + ",SUM(B" + CStr(G) + ") AS BB" + CStr(G)
Next G
Set d1 = db.OpenRecordset("SELECT " + SSSM + " FROM MZ_RB WHERE RB_DATE>CDATE('" + CStr(DATEA) + "') AND RB_DATE<=CDATE('" + CStr(DATEB) + "')")
dd.Range(Chr(i) + "4").Select: dd.ActiveCell.FormulaR1C1 = "量 次"
dd.Range(Chr(i) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!aa1)
dd.Range(Chr(i) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!aa2)
dd.Range(Chr(i) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA3)
dd.Range(Chr(i) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA4)
dd.Range(Chr(i) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA5)
dd.Range(Chr(i) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA6)
dd.Range(Chr(i) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA7)
dd.Range(Chr(i) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA8)
dd.Range(Chr(i) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA9)
dd.Range(Chr(i) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA10)
dd.Range(Chr(i) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA11)
dd.Range(Chr(i) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA12)
dd.Range(Chr(i) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA13)
dd.Range(Chr(i) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA14)
dd.Range(Chr(i) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA15)
dd.Range(Chr(i) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA16)
dd.Range(Chr(i) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA17)
dd.Range(Chr(i) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA18)
dd.Range(Chr(i) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA19)
dd.Range(Chr(i) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA20)
dd.Range(Chr(i) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA21)
dd.Range(Chr(i) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA22)
dd.Range(Chr(i) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA24)
dd.Range(Chr(i) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA23)
II = i + 1
dd.Range(Chr(II) + "4").Select: dd.ActiveCell.FormulaR1C1 = "金  额"
dd.Range(Chr(II) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB1)
dd.Range(Chr(II) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB2)
dd.Range(Chr(II) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB3)
dd.Range(Chr(II) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB4)
dd.Range(Chr(II) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB5)
dd.Range(Chr(II) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB6)
dd.Range(Chr(II) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB7)
dd.Range(Chr(II) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB8)
dd.Range(Chr(II) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB9)
dd.Range(Chr(II) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB10)
dd.Range(Chr(II) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB11)
dd.Range(Chr(II) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB12)
dd.Range(Chr(II) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB13)
dd.Range(Chr(II) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB14)
dd.Range(Chr(II) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB15)
dd.Range(Chr(II) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB16)
dd.Range(Chr(II) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB17)
dd.Range(Chr(II) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB18)
dd.Range(Chr(II) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB19)
dd.Range(Chr(II) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB20)
dd.Range(Chr(II) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB21)
dd.Range(Chr(II) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB22)
dd.Range(Chr(II) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB24)
dd.Range(Chr(II) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB23)
d1.Close
Else
SSSM = "SUM(A1) AS AA1,SUM(B1) AS BB1"
For G = 2 To 24
SSSM = SSSM + ",SUM(A" + CStr(G) + ") AS AA" + CStr(G)
SSSM = SSSM + ",SUM(B" + CStr(G) + ") AS BB" + CStr(G)
Next G
Set d1 = db.OpenRecordset("SELECT " + SSSM + " FROM MZ_RB WHERE KS_ID='" + KSID(j - 1) + "' AND RB_DATE>CDATE('" + CStr(DATEA) + "') AND RB_DATE<=CDATE('" + CStr(DATEB) + "')")
dd.Range(Chr(i) + "4").Select: dd.ActiveCell.FormulaR1C1 = "量 次"
dd.Range(Chr(i) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!aa1)
dd.Range(Chr(i) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!aa2)
dd.Range(Chr(i) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA3)
dd.Range(Chr(i) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA4)
dd.Range(Chr(i) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA5)
dd.Range(Chr(i) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA6)
dd.Range(Chr(i) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA7)
dd.Range(Chr(i) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA8)
dd.Range(Chr(i) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA9)
dd.Range(Chr(i) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA10)
dd.Range(Chr(i) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA11)
dd.Range(Chr(i) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA12)
dd.Range(Chr(i) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA13)
dd.Range(Chr(i) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA14)
dd.Range(Chr(i) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA15)
dd.Range(Chr(i) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA16)
dd.Range(Chr(i) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA17)
dd.Range(Chr(i) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA18)
dd.Range(Chr(i) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA19)
dd.Range(Chr(i) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA20)
dd.Range(Chr(i) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA21)
dd.Range(Chr(i) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA22)
dd.Range(Chr(i) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA24)
dd.Range(Chr(i) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxCStr(d1!AA23)
II = i + 1
dd.Range(Chr(II) + "4").Select: dd.ActiveCell.FormulaR1C1 = "金  额"
dd.Range(Chr(II) + "5").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB1)
dd.Range(Chr(II) + "6").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB2)
dd.Range(Chr(II) + "7").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB3)
dd.Range(Chr(II) + "8").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB4)
dd.Range(Chr(II) + "10").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB5)
dd.Range(Chr(II) + "11").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB6)
dd.Range(Chr(II) + "12").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB7)
dd.Range(Chr(II) + "14").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB8)
dd.Range(Chr(II) + "15").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB9)
dd.Range(Chr(II) + "17").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB10)
dd.Range(Chr(II) + "18").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB11)
dd.Range(Chr(II) + "19").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB12)
dd.Range(Chr(II) + "20").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB13)
dd.Range(Chr(II) + "22").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB14)
dd.Range(Chr(II) + "23").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB15)
dd.Range(Chr(II) + "24").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB16)
dd.Range(Chr(II) + "26").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB17)
dd.Range(Chr(II) + "27").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB18)
dd.Range(Chr(II) + "29").Select: dd.ActiveCell.FormulaR1C1 = DxF(d1!BB19)
dd.Range(Chr(II) + "31").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB20)
dd.Range(Chr(II) + "32").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB21)
dd.Range(Chr(II) + "33").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB22)
dd.Range(Chr(II) + "35").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB24)
dd.Range(Chr(II) + "37").Select: dd.ActiveCell.FormulaR1C1 = DxFF(d1!BB23)
d1.Close
End If
Next i
dd.ActiveWorkbook.PrintPreview
Next KK
dd.ActiveWorkbook.Saved = True
dd.ActiveWorkbook.Close
dd.Quit
MsgBox "打印完毕!"
End Sub

Sub MZYSRB(DATE1 As Date)
print_head = "爱龄奇医院门诊医生工作量日统计表"
'Printer.TextHeight = 10
Dim d1 As Recordset
Dim d2 As Recordset
Dim d3 As Recordset
Dim XMID(30) As String
Dim XMNAME(30) As String
For i = 1 To 30
XMID(i) = " "
XMNAME(i) = " "
Next i
F_HJ = 1
XX = "SUM(B1) AS BB1"
For i = 2 To 26
XX = XX + ",SUM(B" + CStr(i) + ") AS BB" + CStr(i)
Next i
Set d1 = db.OpenRecordset("SELECT " + XX + " FROM MZYS_RB WHERE RB_DATE=CDATE('" + CStr(DATE1) + "')")
For i = 1 To 26
XX = "BB" + CStr(i)
If Not IsNull(d1.Fields(XX).Value) Then
If d1.Fields(XX).Value <> 0 Then
If i = 1 Then
XMID(F_HJ) = CStr(i)
XMNAME(F_HJ) = "挂号费"
F_HJ = F_HJ + 1
Else
Set d2 = db.OpenRecordset("SELECT * FROM XM_TABLE WHERE MZ_YS=CLNG('" + CStr(i) + "')")
XMID(F_HJ) = CStr(i)
XMNAME(F_HJ) = d2!XM_BBNAME
F_HJ = F_HJ + 1
d2.Close
End If
End If
End If
Next i
d1.Close
F_HJ = F_HJ - 1
F_PAGE = 1 + Int(F_HJ / 9)
x_page = 1
F_P = 1
JJ = 1
Printer.ScaleMode = 6
Printer.PaperSize = 39
Set d1 = db.OpenRecordset("SELECT TOP 1 * FROM MZYS_RB WHERE RB_DATE=CDATE('" + CStr(DATE1) + "')")
P_D1 = d1!RB_DATE1
p_d2 = d1!RB_DATE2
d1.Close
If CDate(P_D1) = CDate("2000-01-01") Then
P_D1 = "    -  -  "
End If
PLINE = 0
Printer.FontName = "隶书"
Printer.FontSize = 22
Printer.FontUnderline = True
Printer.CurrentX = 75
Printer.Print "   " + print_head + "   "
Printer.FontUnderline = False
Printer.FontSize = 9.5
Printer.Print
Printer.FontName = "宋体"
Printer.FontSize = 9.5
Printer.FontUnderline = False
Printer.Print "   统计日期：[" + Left(CStr(p_d2), 10) + "] 统计时间：[" + Right(CStr(p_d2), 8) + "]   统计期间：[" + Left(CStr(P_D1), 10) + " 至 " + Left(CStr(p_d2), 10) + "]" + Space(20) + "  打印日期：[" + CStr(Date) + " "; CStr(Time) + "]"
Do While JJ <= F_HJ
If JJ = 1 Then
UU = "│    │        │          "
UU1 = "│    │        │          "
UU2 = "│    │        │          "
U1 = "┌──┬────
上一页 1 2 3 45
⌨️ 快捷键说明

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