📄 pub_memo.bas
字号:
'****************************************************************
'* 功 能 : 用窄打纸打印,每页50条记录,可以选择左右打印方式,求和
'* 参数说明: DY_REC :包含全部打印信息的记录集
'* DY_BT :表头
'* FIEL_NAME :列名
'* FIEL_LONG :列的最大打印长度
'* X_FIRST :表的起始位置,0-14000之间
'* TOTAL :数组，个数为字段个数
'* 11--左对齐，不统计合计， 12--左对齐，统计合计
'* 21--右对齐，不统计合计， 22--右对齐，统计合计
'****************************************************************
Public Function print_tabler(dy_rec As Recordset, dy_bt As String, fiel_name As Variant, fiel_long As Variant, x_first As Integer, total As Variant)
Dim m As Integer, n As Integer, j As Integer, k As Integer, m_long As Integer, i As Integer
Dim dx As Integer, y_first As Integer, dy As Integer, pot_pot As Integer, line_high As Integer
Dim sum As Variant, tal As Variant
ReDim sum(dy_rec.Fields.Count)
m_long = 0
For i = 1 To dy_rec.Fields.Count
m_long = m_long + fiel_long(i - 1)
Next
y_first = 1400
pot_pot = 100
line_high = 220
dy_rec.MoveLast
k = dy_rec.RecordCount
m = Int(k / 50) '页数
n = k Mod 50 '剩余记录数
Printer.PaperSize = vbPRPSUser
Printer.Width = 14000
Printer.Height = 16000
dy_rec.MoveFirst
For i = 1 To m
Printer.FontSize = 16
Printer.FontBold = True
Printer.CurrentX = x_first
Printer.CurrentY = 500
Printer.Print dy_bt
Printer.FontSize = 10
dx = x_first
Printer.CurrentX = dx
For j = 1 To dy_rec.Fields.Count
Printer.CurrentY = 1000
Call prt_fiel(Trim(fiel_name(j - 1)), fiel_long(j - 1), total(j - 1)) '打印表头
dx = dx + fiel_long(j - 1) * pot_pot
Printer.CurrentX = dx
Next
Printer.Line (x_first, 1300)-(x_first + m_long * pot_pot, 1300) 'PRINT ------------
Printer.FontBold = False
dy = y_first
For k = 1 To 50
Call sum_S(dy_rec, sum, tal, total)
dx = x_first
For j = 1 To dy_rec.Fields.Count
Printer.CurrentX = dx
Printer.CurrentY = dy
Dim a As String
If Len(Trim(dy_rec.Fields(j - 1))) <> 0 Then
Call prt_fiel(Trim(dy_rec.Fields(j - 1)), fiel_long(j - 1), total(j - 1))
Else
Printer.Print " "
End If
dx = dx + fiel_long(j - 1) * pot_pot
Next
dy = dy + line_high
Printer.CurrentY = dy
dy_rec.MoveNext
Next
Printer.Line (x_first, 13000)-(x_first + m_long * pot_pot, 13000)
Printer.CurrentX = 0
Printer.CurrentY = 13050
Printer.Print "合计"
dx = x_first
Printer.CurrentX = dx
For j = 1 To dy_rec.Fields.Count
Printer.CurrentY = 13050
Call prt_fiel(sum(j - 1), fiel_long(j - 1), total(j - 1)) '打印和
dx = dx + fiel_long(j - 1) * pot_pot
Printer.CurrentX = dx
Next
Printer.CurrentX = x_first
Printer.CurrentY = 13500
Printer.Print "第"; i; " 页,共"; m + 1; " 页 打印时间:"; Date; " 制表人:"; SYS_NAME
Printer.NewPage
Next
Printer.FontSize = 16
Printer.FontBold = True
Printer.CurrentX = x_first
Printer.CurrentY = 500
Printer.Print dy_bt
Printer.FontSize = 10
dx = x_first
Printer.CurrentX = dx
For j = 1 To dy_rec.Fields.Count
Printer.CurrentY = 1000
Call prt_fiel(Trim(fiel_name(j - 1)), fiel_long(j - 1), total(j - 1)) '打印表头
dx = dx + fiel_long(j - 1) * pot_pot
Printer.CurrentX = dx
Next
Printer.Line (x_first, 1300)-(x_first + m_long * pot_pot, 1300) 'PRINT ------------
Printer.FontBold = False
dy = y_first
For k = 1 To n
Call sum_S(dy_rec, sum, tal, total)
dx = x_first
For j = 1 To dy_rec.Fields.Count
Printer.CurrentX = dx
Printer.CurrentY = dy
If Len(Trim(dy_rec.Fields(j - 1))) <> 0 Then
Call prt_fiel(Trim(dy_rec.Fields(j - 1)), fiel_long(j - 1), total(j - 1))
Else
Printer.Print " "
End If
dx = dx + fiel_long(j - 1) * pot_pot
Next
dy = dy + line_high
Printer.CurrentY = dy
dy_rec.MoveNext
Next
Printer.Line (x_first, 13300)-(x_first + m_long * pot_pot, 13300)
Printer.CurrentX = 0
Printer.CurrentY = 13050
Printer.Print "合计"
dx = x_first
Printer.CurrentX = dx
For j = 1 To dy_rec.Fields.Count
Printer.CurrentY = 13050
Call prt_fiel(sum(j - 1), fiel_long(j - 1), total(j - 1)) '打印和
dx = dx + fiel_long(j - 1) * pot_pot
Printer.CurrentX = dx
Next
Printer.CurrentX = 0
Printer.CurrentY = 13250
Printer.Print "总计"
Printer.CurrentX = x_first
Printer.CurrentY = 13600
Printer.Print "第"; m + 1; " 页,共"; m + 1; " 页 打印时间:"; Date; " 制表人:"; SYS_NAME
Printer.EndDoc
End Function
Private Function sum_S(t1_rec As Recordset, t1_sum As Variant, t1_tal As Variant, tot As Variant)
't1_rec 源记录集
't1_sum 页求和
't1_TAL 总计
'tot 数组
Dim i As Integer, n As Integer
For i = 1 To t1_rec.Fields.Count
t1_sum(i - 1) = 0
Next
For i = 1 To t1_rec.Fields.Count
If tot(i - 1) = 12 Or tot(i - 1) = 22 Then
t1_sum(i - 1) = t1_sum(i - 1) + t1_rec.Fields(i - 1)
t1_tal(i - 1) = t1_tal(i - 1) + t1_rec.Fields(i - 1)
End If
Next
End Function
Private Function prt_fiel(fil_name As Variant, fil_long As Variant, tot As Variant)
Dim i As Integer, m As Integer, ll As String
If tot = 11 Or tot = 12 Then
Printer.Print LeftB$(CStr(Trim(fil_name)) + Space(2 * fil_long), 2 * fil_long)
Else
m = fil_long '字符长
For i = 1 To Len(fil_name)
If Asc(Mid(Trim(fil_name), i, 1)) < 0 Then
m = m - 2
Else: m = m - 1
End If
Next
Printer.Print Spc(m); CStr(Trim(fil_name))
End If
End Function
'**************************************************************************************************
'* 功 能 : 预订单, 成员卡片归档
'* 作 者 : 梁卫
'* 作成日期 : 1999.04.05
'* 修改日期 : 1999.04.05
'**************************************************************************************************
Public Function pub_yden(t_ydd_h As String, t_code As String) As Boolean
'说明： t_bj ‘0’- 预订解除 ‘1’- 未到达预订转等待 ‘2’- 有预订入住归档 ‘3’- 预订等待解除归档
Dim yddk_rec As Recordset
Dim temp_rzft As Boolean '表示当前预订单的客人是否入住
Dim temp_dffls As Variant
Dim temp_i As Integer
Dim temp_bj As String
Dim t_tools As New HOTEL_TOOL.HOTEL_TOOLS
Dim ydkr_rec As Recordset
Dim LOCK_REC As Recordset
Dim ydend_rec As Recordset
Dim ykend_rec As Recordset
Dim ycend_rec As Recordset
Dim t_rec As Recordset
Dim j As Long
Dim T_LSH As String
Dim temp_YDname As String '预订单的归档表名
Dim temp_YKname As String '预订客人的归档表名
Dim temp_YCname As String '预订就餐的归档表名
Dim temp_YD As String '预订单(或预订等待)的表名
Dim temp_YK As String '预订客人(或等待客人)的表名
Dim temp_YC As String '预订就餐(或等待就餐)的表名
Dim temp_lock As Integer
pub_yden = False
temp_rzft = False
ReDim temp_dffls(SYS_LXN + 1)
For temp_i = 1 To SYS_LXN
temp_dffls(temp_i) = 0
Next
Select Case t_code
Case "A0300" '预订解除
temp_rzft = False
temp_bj = "0"
pub_yden = True
temp_YD = "YD_YDDK"
temp_YK = "YD_KRQD"
temp_YC = "YD_TDJC"
temp_YDname = "YD" & year(Date)
temp_YKname = "YK" & year(Date)
temp_YCname = "YC" & year(Date)
Case "A0310" '预订转等待
temp_rzft = False
temp_bj = "1"
pub_yden = True
temp_YD = "YD_YDDK"
temp_YK = "YD_KRQD"
temp_YC = "YD_TDJC"
temp_YDname = "YD_WAIT"
temp_YKname = "YK_WAIT"
temp_YCname = "YC_WAIT"
Case "A0420" '预订等待解除归档
temp_rzft = False
temp_bj = "3"
pub_yden = True
temp_YD = "YD_WAIT"
temp_YK = "YK_WAIT"
temp_YC = "YC_WAIT"
temp_YDname = "YD" & year(Date)
temp_YKname = "YK" & year(Date)
temp_YCname = "YC" & year(Date)
Case "B0110", "B0130" '有预订散客登记, 有预订团队登记
temp_rzft = True
temp_bj = "2"
pub_yden = True
temp_YD = "YD_YDDK"
temp_YK = "YD_KRQD"
temp_YC = "YD_TDJC"
temp_YDname = "YD" & year(Date)
temp_YKname = "YK" & year(Date)
temp_YCname = "YC" & year(Date)
Case Else
pub_yden = False
End Select
If pub_yden Then
Set yddk_rec = PUB_data.OpenRecordset("SELECT * FROM " & Trim(temp_YD) & " WHERE TRIM(YDD_H)='" & Trim(t_ydd_h) & "'", 2, 0, 2)
If Not yddk_rec.BOF Then
yddk_rec.MoveLast
Do
temp_lock = Pub_lock("PUBLIC", Trim(temp_YD), yddk_rec)
Loop Until temp_lock <> 0
Select Case temp_lock
Case 1 '加锁
Set LOCK_REC = PUB_data.OpenRecordset("SELECT * FROM SYS_LOCK", 2, 0, 2)
If Not LOCK_REC.BOF Then
LOCK_REC.MoveLast
LOCK_REC.FindFirst "TRIM(TABLENAME)='" & Trim(temp_YK) & "'"
Do While LOCK_REC!CZY <> SYS_USER
If LOCK_REC!CZY = "***" Then
LOCK_REC.Edit
LOCK_REC!CZY = SYS_USER
LOCK_REC.Update
Else
Select Case t_code
Case "A0300", "A0310" '预订解除
Call t_tools.pub_msg("预订客人清单表正被其他人使用，请稍候")
Case "A0420" '预订等待解除归档
Call t_tools.pub_msg("预订等待客人清单表正被其他人使用，请稍侯")
End Select
LOCK_REC.Requery
If Not LOCK_REC.BOF Then
LOCK_REC.MoveLast
LOCK_REC.MoveFirst
End If
LOCK_REC.FindFirst "TRIM(TABLENAME)='" & Trim(temp_YK) & "'"
End If
Loop
LOCK_REC.FindFirst "TRIM(TABLENAME)='" & Trim(temp_YC) & "'"
Do While LOCK_REC!CZY <> SYS_USER
If LOCK_REC!CZY = "***" Then
LOCK_REC.Edit
LOCK_REC!CZY = SYS_USER
LOCK_REC.Update
Else
Select Case t_code
Case "A0300", "A0310" '预订解除
Call t_tools.pub_msg("预订团队就餐表正被其他人使用，请稍侯")
Case "A0420" '预订等待解除归档
Call t_tools.pub_msg("预订等待团队就餐表正被其他人使用，请稍侯")
End Select
LOCK_REC.Requery
If Not LOCK_REC.BOF Then
LOCK_REC.MoveLast
LOCK_REC.MoveFirst
End If
LOCK_REC.FindFirst "TRIM(TABLENAME)='" & Trim(temp_YC) & "'"
End If
Loop
'把预订客人归档
'***********************************************
PUB_data.Execute "INSERT INTO " & temp_YKname & " SELECT * FROM " & Trim(temp_YK) & " WHERE TRIM(YDD_H)='" & Trim(t_ydd_h) & "'"
PUB_data.Execute "UPDATE " & temp_YKname & " SET RZ_FT=" & temp_rzft & " WHERE TRIM(YDD_H)='" & Trim(t_ydd_h) & "'"
PUB_data.Execute "DELETE FROM " & Trim(temp_YK) & " WHERE TRIM(YDD_H)='" & Trim(t_ydd_h) & "'"
'*****************转预订单号为等待单号
If t_code = "A0310" Then
For j = 1 To 999999999
T_LSH = Mid(t_ydd_h, 1, 2) + "W" + Right("00000000" & j, 9)
Set t_rec = PUB_data.OpenRecordset("select YDD_H from YK_WAIT where YDD_H='" & T_LSH & "'", 4)
If Not t_rec.BOF Then
t_rec.MoveLast
Else: Exit For
End If
Next
PUB_data.Execute "UPDATE " & temp_YKname & " SET YDD_H='" & T_LSH & "' WHERE TRIM(YDD_H)='" & Trim(t_ydd_h) & "'"
End If
Set ykend_rec = PUB_data.OpenRecordset("SELECT * FROM " & temp_YKname & " WHERE TRIM(YDD_H)='" & t_ydd_h & "'", 4, 0, 2)
If Not ykend_rec.BOF Then
ykend_rec.MoveLast
ykend_rec.MoveFirst
Do While Not ykend_rec.EOF
If Trim(ykend_rec.Fields("GZ_FH")) <> "" Then
Call pub_kfgz(ykend_rec.Fields("GZ_FH"), "0")
End If
ykend_rec.MoveNext
Loop
End If
ykend_rec.Close
'把团队就餐信息归档
PUB_data.Execute "INSERT INTO " & temp_YCname & " SELECT * FROM " & Trim(temp_YC) & " WHERE TRIM(YDD_H)='" & Trim(t_ydd_h) & "'"
PUB_data.Execute "DELETE FROM " & Trim(temp_YC) & " WHERE TRIM(YDD_H)='" & Trim(t_ydd_h) & "'"
'*****************转预订单号为等待单号
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -