📄 科室核算汇总表.frm
字号:
VERSION 5.00
Begin VB.Form frmDepartmentAccounting
Caption = "住院管理-报表打印"
ClientHeight = 2700
ClientLeft = 1800
ClientTop = 2820
ClientWidth = 6300
LinkTopic = "Form44"
LockControls = -1 'True
ScaleHeight = 2700
ScaleWidth = 6300
Begin VB.Frame Frame1
Height = 1935
Left = 165
TabIndex = 0
Top = 585
Width = 5925
Begin VB.TextBox Text1
BackColor = &H00C0FFC0&
BeginProperty Font
Name = "System"
Size = 12
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H000000C0&
Height = 375
Left = 3255
Locked = -1 'True
TabIndex = 5
Text = "2000-02-25"
Top = 405
Width = 1635
End
Begin VB.VScrollBar VScroll1
Height = 375
Left = 4860
Max = 10000
Min = -10000
TabIndex = 4
Top = 405
Width = 255
End
Begin VB.CommandButton Command1
Caption = "打 印"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 390
TabIndex = 2
Top = 1305
Width = 2070
End
Begin VB.CommandButton Command2
Caption = "退 出"
BeginProperty Font
Name = "隶书"
Size = 14.25
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 390
Left = 3330
TabIndex = 1
Top = 1290
Width = 2070
End
Begin VB.Label Label2
Caption = "请输入报表月份:"
BeginProperty Font
Name = "隶书"
Size = 15.75
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00FF0000&
Height = 375
Left = 690
TabIndex = 6
Top = 420
Width = 2505
End
Begin VB.Line Line1
BorderColor = &H80000010&
X1 = 5880
X2 = 0
Y1 = 1020
Y2 = 1020
End
Begin VB.Line Line2
BorderColor = &H8000000E&
X1 = 15
X2 = 5910
Y1 = 1035
Y2 = 1035
End
End
Begin VB.Label Label1
Caption = "科 室 核 算 汇 总 表"
BeginProperty Font
Name = "隶书"
Size = 18
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00C00000&
Height = 360
Left = 1125
TabIndex = 3
Top = 150
Width = 3675
End
End
Attribute VB_Name = "frmDepartmentAccounting"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim PrintTime As Date
Dim FirstHeader As String
Dim SecondHeader As String
Dim FirstLine As String
Dim SheetLine As String
Dim LastLine As String
Dim SH1 As String
Dim SH2 As String
Dim SH3 As String
Dim SheetData As String
Dim PagePos As Integer
Dim DataPos As Integer
Dim RowPos As Integer
Dim RowMax As Integer
Dim DataRs As Recordset
PagePos = 1
PrintTime = CDate(Text1.Text + "-26")
PrintTime = DateAdd("m", -1, PrintTime)
Set DataRs = db.OpenRecordset("select * from zy_kshs where yb_date2 >cdate('" + CStr(PrintTime) + "') and yb_date2<cdate('" + Text1.Text & "-25') order by hs_ks_id")
FirstHeader = CStr(Year(PrintTime)) + "年" + CStr(Month(PrintTime)) + "月份科室核算汇总表"
SecondHeader = "北安市第一人民医院" + Space(15) + CStr(Year(PrintTime)) + "年" + CStr(Month(PrintTime)) + "月" + CStr(Day(PrintTime)) + "日" + Space(15) + "金额单位:元"
' "┬┴├┤┼┌└─┐┘│＼／├┤┬┴" "┬┴├┤┼┌└─┐┘│＼／├┤┬┴" "┬┴├┤┼┌└─┐┘│＼／├┤┬┴" "┬┴├┤┼┌└─┐┘│＼／├┤┬┴"
FirstLine = "┌─┬─────┬───────────────────────┬───────────────────────────────┬─────┬─────┬─────┬──────────┐"
SH1 = "│顺│＼金＼项 │ 收 入 │ 支 出 │ 结 │ 定 │ 超 │ │"
SH2 = "│ │科＼额＼目├─────┬─────┬─────┬─────┼─────┬────┬─────┬────┬────┬────┤ │ │ │ 说 明 │"
SH3 = "│序│ 别 ＼ ＼│ 合 计 │ 医 疗 费 │ 例 次 │床费/药费 │ 合 计 │15%加提 │卫材+卫杂 │ 卫 材 │ 卫 杂 │ 氧 气 │ 余 │ 额 │ 额 │ │"
SheetLine = "├─┼─────┼─────┼─────┼─────┼─────┼─────┼────┼─────┼────┼────┼────┼─────┼─────┼─────┼──────────┤"
LastLine = "└─┴─────┴─────┴─────┴─────┴─────┴─────┴────┴─────┴────┴────┴────┴─────┴─────┴─────┴──────────┘"
'****************
Printer.PaperSize = 39
Printer.ScaleMode = 6
'****************
Printer.Font = "宋体"
Printer.FontSize = 19
Printer.FontBold = True
Printer.FontUnderline = True
Printer.CurrentX = 120
Printer.Print FirstHeader
Printer.FontSize = 13
Printer.FontUnderline = False
Printer.CurrentX = 60
Printer.Print SecondHeader
'***************
Printer.Font = "宋体"
Printer.FontBold = False
Printer.FontSize = 9.5
Printer.Print
Printer.Print FirstLine
Printer.Print SH1
Printer.Print SH2
Printer.Print SH3
'***************
RowMax = 26
RowPos = 0
While Not DataRs.EOF
RowPos = RowPos + 1
If RowPos > RowMax Then
PagePos = PagePos + 1
Printer.Print LastLine
Printer.NewPage
'****************
Printer.Font = "宋体"
Printer.FontSize = 19
Printer.FontBold = True
Printer.FontUnderline = True
Printer.CurrentX = 120
Printer.Print FirstHeader
Printer.FontSize = 13
Printer.FontUnderline = False
Printer.CurrentX = 60
Printer.Print SecondHeader
'***************
Printer.Font = "宋体"
Printer.FontBold = False
Printer.FontSize = 9.5
Printer.Print
Printer.Print FirstLine
Printer.Print SH1
Printer.Print SH2
Printer.Print SH3
Printer.Print SheetLine
'***************
RowPos = 1
Else
Printer.Print SheetLine
End If
SheetData = "│" + DataRs!hs_ks_id + "│" + DxLeft(DataRs!hs_ks_name, 10) + Space(10 - DxLen(DxLeft(DataRs!hs_ks_name, 10))) + "│" + _
Space(10 - Len(Left(CStr(DataRs!hj_in), 10))) + Left(CStr(DataRs!hj_in), 10) + "│" + Space(10 - Len(Left(CStr(DataRs!JE), 10))) + Left(CStr(DataRs!JE), 10) + "│" + _
Space(10 - Len(Left(CStr(DataRs!lc), 10))) + Left(CStr(DataRs!lc), 10) + "│" + Space(10 - Len(Left(CStr(DataRs!other), 10))) + Left(CStr(DataRs!other), 10) + "│" + _
Space(10) + "│" + Space(8) + "│" + _
Space(10 - Len(Left(CStr(DataRs!hj_out), 10))) + Left(CStr(DataRs!hj_out), 10) + "│" + Space(8 - Len(Left(CStr(DataRs!wc_je), 8))) + Left(CStr(DataRs!wc_je), 8) + "│" + _
Space(8 - Len(Left(CStr(DataRs!wz_je), 8))) + Left(CStr(DataRs!wz_je), 8) + "│" + Space(8 - Len(Left(CStr(DataRs!yq_sl), 8))) + Left(CStr(DataRs!yq_sl), 8) + "│" + _
Space(10) + "│" + Space(10) + "│" + Space(10) + "│" + Space(20) + "│"
Printer.Print SheetData
DataRs.MoveNext
Wend
Printer.Print LastLine
Printer.EndDoc
DataRs.Close
End Sub
Private Sub Command2_Click()
Unload Me
End Sub
Private Sub Form_Load()
Text1.Text = Left(CStr(Date), 7)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Form3.Enabled = True
Form3.SetFocus
End Sub
Private Sub VScroll1_Change()
Text1.Text = Left(CStr(DateAdd("m", VScroll1.Value, Date)), 7)
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -