📄 sk_print04.frm
字号:
Begin VB.Line Line6
X1 = 360
X2 = 8880
Y1 = 3240
Y2 = 3240
End
Begin VB.Line Line5
X1 = 360
X2 = 8880
Y1 = 2640
Y2 = 2640
End
Begin VB.Line Line4
BorderWidth = 2
X1 = 360
X2 = 360
Y1 = 1560
Y2 = 4320
End
Begin VB.Line Line3
X1 = 360
X2 = 8880
Y1 = 2040
Y2 = 2040
End
Begin VB.Line Line2
BorderWidth = 2
X1 = 360
X2 = 8880
Y1 = 1560
Y2 = 1560
End
Begin VB.Label 药费
AutoSize = -1 'True
Height = 180
Left = 1440
TabIndex = 18
Top = 2280
Width = 90
End
Begin VB.Label 出生证
AutoSize = -1 'True
Height = 180
Left = 2400
TabIndex = 17
Top = 2280
Width = 90
End
Begin VB.Label 妇检
AutoSize = -1 'True
Height = 180
Left = 3600
TabIndex = 16
Top = 2280
Width = 90
End
Begin VB.Label 妇科
AutoSize = -1 'True
Height = 180
Left = 4560
TabIndex = 15
Top = 2280
Width = 90
End
Begin VB.Label 处置
AutoSize = -1 'True
Height = 180
Left = 5640
TabIndex = 14
Top = 2160
Width = 90
End
Begin VB.Label 访视
AutoSize = -1 'True
Height = 180
Left = 6720
TabIndex = 13
Top = 2160
Width = 90
End
Begin VB.Label 儿检
AutoSize = -1 'True
Height = 180
Left = 7800
TabIndex = 12
Top = 2160
Width = 90
End
Begin VB.Label 检查费
AutoSize = -1 'True
Height = 180
Left = 1440
TabIndex = 11
Top = 3360
Width = 90
End
Begin VB.Label 手术费
AutoSize = -1 'True
Height = 180
Left = 2400
TabIndex = 10
Top = 3360
Width = 90
End
Begin VB.Label 照像费
AutoSize = -1 'True
Height = 180
Left = 3480
TabIndex = 9
Top = 3360
Width = 90
End
Begin VB.Label b超
AutoSize = -1 'True
Height = 180
Left = 4560
TabIndex = 8
Top = 3360
Width = 90
End
Begin VB.Label 心电图
AutoSize = -1 'True
Height = 180
Left = 5640
TabIndex = 7
Top = 3360
Width = 90
End
Begin VB.Label v_daxie
AutoSize = -1 'True
Height = 180
Left = 2400
TabIndex = 6
Top = 3960
Width = 90
End
Begin VB.Label Label9
AutoSize = -1 'True
Caption = " 收 款 重 新 打 印"
BeginProperty Font
Name = "黑体"
Size = 15
Charset = 134
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
ForeColor = &H00800000&
Height = 300
Left = 3120
TabIndex = 5
Top = 240
Width = 2880
End
End
Attribute VB_Name = "sk_print04"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Public c_id3 As String
Public Sub ShowErr()
c = MsgBox("打印机连接失败，请检查！", vbQuestion, "系统提示！")
End Sub
'*********************************************************
'* 名称：nNumber2Chinese
'* 功能：数值转换为人民币(汉字)
'* 用法：nNumber2Chinese(数值)
'*********************************************************
Public Function Num2Chi(txtJE As Double) As String
Dim i, k As Integer
Dim NC, nd, ka, chrNum, strZheng As String
Dim c1, c2, c3 As String
Dim K1 As Integer
Dim Zheng As String
Dim Xiao As String
NC = Trim(Format(txtJE, "##0.00"))
c1 = "仟佰拾万仟佰拾亿仟佰拾万仟佰拾元"
c2 = "角分"
c3 = "玖捌柒陆伍肆叁贰壹"
If NC = 0 Then
Num2Chi = "零元整"
Exit Function
End If
Num2Chi = ""
Zheng = Mid(NC, 1, (Len(NC) - 3))
Xiao = Mid(NC, (Len(Zheng) + 2))
If Val(Xiao) <> 0 Then
For i = Len(Xiao) To 1 Step -1
chrNum = Mid(Xiao, i, 1)
If chrNum <> 0 Then
Num2Chi = Mid(c2, i, 1) & Num2Chi
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
End If
Next i
End If
k = 0
If Val(Zheng) <> 0 Then
Num2Chi = "元" & Num2Chi
For i = Len(Zheng) To 1 Step -1
If (Len(Zheng) - i) = 4 Then
Num2Chi = "万" & Num2Chi
ElseIf (Len(Zheng) - i) = 8 Then
Num2Chi = "亿" & Num2Chi
ElseIf (Len(Zheng) - i) = 12 Then
Num2Chi = "万" & Num2Chi
End If
chrNum = Mid(Zheng, i, 1)
If chrNum <> 0 Then
If i = Len(Zheng) Then
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
Else
If (Len(Zheng) - i) <> 4 And (Len(Zheng) - i) <> 8 And (Len(Zheng) - i) <> 12 Then
Num2Chi = Mid(c1, (Len(c1) - k), 1) & Num2Chi
End If
Num2Chi = Mid(c3, (Len(c3) - chrNum + 1), 1) & Num2Chi
End If
Else
If Mid(Num2Chi, 1, 1) <> "元" And Mid(Num2Chi, 1, 1) <> "万" And Mid(Num2Chi, 1, 1) <> "亿" Then
If Mid(Num2Chi, 1, 1) <> "零" Then
Num2Chi = "零" & Num2Chi
End If
End If
End If
k = k + 1
Next i
End If
If Right(Trim(Num2Chi), 1) <> "分" Then
Num2Chi = Num2Chi & "整"
End If
v_daxie.Caption = Num2Chi
End Function
Private Sub Command1_Click()
Unload Me
End Sub
Private Sub Command2_Click()
On Error GoTo ErrorHandle
sk_hj041.PrintForm
Exit Sub
ErrorHandle:
ShowErr
End Sub
Private Sub Command6_Click()
Dim sql88 As String
If Option2.Value = True Then
sql88 = "select * from 收费表 where 编码='" + Trim(CStr(s_ma.Text)) + "' order by -id"
End If
If Option1.Value = True Then
sql88 = "select * from 收费表 where 姓名='" + Trim(CStr(s_ma.Text)) + "' order by -id"
End If
Dim rs88 As New ADODB.Recordset
rs88.Open sql88, db
If Not rs88.EOF Then
c_id3 = rs88("id")
z_bianma = rs88("编码")
z_name = rs88("姓名")
z_sj = rs88("日期")
z_yaofei = rs88("西药费")
If z_yaofei = 0 Then
z_yaofei = ""
Else
z_yaofei = FormatNumber(z_yaofei, 2)
End If
xiyao.Caption = z_yaofei
z_chusheng = rs88("中成药")
If z_chusheng = 0 Then
z_chusheng = ""
Else
z_chusheng = FormatNumber(z_chusheng, 2)
End If
zhongcheng.Caption = z_chusheng
z_fujian = rs88("中草药")
If z_fujian = 0 Then
z_fujian = ""
Else
z_fujian = FormatNumber(z_fujian, 2)
End If
zhongcao.Caption = z_fujian
z_fuke = rs88("检查费")
If z_fuke = 0 Then
z_fuke = ""
Else
z_fuke = FormatNumber(z_fuke, 2)
End If
Label1.Caption = z_fuke
z_chuzhi = rs88("电诊费")
If z_chuzhi = 0 Then
z_chuzhi = ""
Else
z_chuzhi = FormatNumber(z_chuzhi, 2)
End If
dianzhenfei.Caption = z_chuzhi
z_fangshi = rs88("化验费")
If z_fangshi = 0 Then
z_fangshi = ""
Else
z_fangshi = FormatNumber(z_fangshi, 2)
End If
huayanfei1.Caption = z_fangshi
z_erjian = rs88("照透费")
If z_erjian = 0 Then
z_erjian = ""
Else
z_erjian = FormatNumber(z_erjian, 2)
End If
zaotoufei1.Caption = z_erjian
z_huayan = rs88("治疗费")
If z_huayan = 0 Then
z_huayan = ""
Else
z_huayan = FormatNumber(z_huayan, 2)
End If
Label2.Caption = z_huayan
z_jiancha = rs88("处置费")
If z_jiancha = 0 Then
z_jiancha = ""
Else
z_jiancha = FormatNumber(z_jiancha, 2)
End If
chuzhi1.Caption = z_jiancha
z_shoushu = rs88("手术费")
If z_shoushu = 0 Then
z_shoushu = ""
Else
z_shoushu = FormatNumber(z_shoushu, 2)
End If
shoushu1.Caption = z_shoushu
z_zhaoxiang = rs88("床费")
If z_zhaoxiang = 0 Then
z_zhaoxiang = ""
Else
z_zhaoxiang = FormatNumber(z_zhaoxiang, 2)
End If
chaungfei.Caption = z_zhaoxiang
z_bc = rs88("体检费")
If z_bc = 0 Then
z_bc = ""
Else
z_bc = FormatNumber(z_bc, 2)
End If
tijianfei1.Caption = z_bc
z_daxie = rs88("大写金额")
'获得操作员编码
sql881 = "select * from 人名 where 姓名='" + Trim(CStr(v_denglu.v_name1)) + "'"
Dim rs881 As New ADODB.Recordset
rs881.Open sql881, db
If Not rs881.EOF Then
Else
z_caozuo = "无"
End If
z_xiaoxie = rs88("金额")
If z_xiaoxie = 0 Then
z_xiaoxie = ""
Else
z_xiaoxie = FormatNumber(z_xiaoxie, 2)
End If
'编码.Caption = z_bianma
姓名.Caption = Trim(z_name)
时间.Caption = Trim(z_sj)
大写.Caption = Trim(z_daxie)
金额.Caption = Trim(z_xiaoxie)
操作员.Caption = Trim(z_caozuo)
Command2.Enabled = True
'-----------------------------------
Else
b1 = MsgBox("没有找到任何数据！", vbQuestion, "系统提示！")
Command2.Enabled = False
v_daxie.Caption = ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -