📄 通知单打印.frm
字号:
End Sub
'*********************************************************************
'*函数说明: 初始化报表的 Toolbar *
'*参 数: tlb Toolbar *
'* Imag1 ImageList *
'*返回值 : *
'*********************************************************************
Private Sub REPTlb(tlb As ToolBar, Img1 As ImageList)
Dim imgt As ListImage
Dim id As Integer
Set imgt = Img1.ListImages.Add(, "Set", LoadResPicture(307, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "Print", LoadResPicture(314, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "Preview", LoadResPicture(312, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "BatchPrn", LoadResPicture(313, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "Seek", LoadResPicture(331, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "Modify", LoadResPicture(324, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "Save", LoadResPicture(1145, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "PriorPage", LoadResPicture(1139, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "NextPage", LoadResPicture(1133, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "FirstPage", LoadResPicture(1174, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "LastPage", LoadResPicture(1117, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "Help", LoadResPicture(396, vbResBitmap))
Set imgt = Img1.ListImages.Add(, "exit", LoadResPicture(1118, vbResBitmap))
With tlb
.Buttons("Set").Image = "Set"
.Buttons("Set").ToolTipText = "Ctrl+W"
.Buttons("Print").Image = "Print"
.Buttons("Print").ToolTipText = "Ctrl+P"
.Buttons("Preview").Image = "Preview"
' .Buttons("Preview").ToolTipText = "Ctrl+S" 'cuidong 2001.01.15
.Buttons("Preview").ToolTipText = "" 'cuidong 2001.01.15
.Buttons("BatchPrn").Image = "BatchPrn"
.Buttons("BatchPrn").ToolTipText = "Ctrl+B"
.Buttons("Seek").Image = "Seek"
.Buttons("Seek").ToolTipText = "Ctrl+C"
.Buttons("Modify").Image = "Modify"
.Buttons("Modify").ToolTipText = "Ctrl+M"
.Buttons("Save").Image = "Save"
.Buttons("Save").ToolTipText = "Ctrl+A"
.Buttons("PriorPage").Image = "PriorPage"
.Buttons("PriorPage").ToolTipText = "Ctrl+PageUp"
.Buttons("NextPage").Image = "NextPage"
.Buttons("NextPage").ToolTipText = "Ctrl+PageDown"
.Buttons("FirstPage").Image = "FirstPage"
.Buttons("FirstPage").ToolTipText = "Ctrl+HomePage"
.Buttons("LastPage").Image = "LastPage"
.Buttons("LastPage").ToolTipText = "Ctrl+EndPage"
.Buttons("Help").Image = "Help"
.Buttons("Help").ToolTipText = "F1"
.Buttons("exit").Image = "exit"
.Buttons("exit").ToolTipText = "Alt+F4"
End With
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
Select Case KeyCode
Case vbKeyF4
If Shift = 2 Then
Gen_Key "Exit"
End If
Case vbKeyP
If Shift = 2 Then
Gen_Key "Print"
End If
Case vbKeyS
'cuidong 2001.01.15
'If Shift = 2 Then
' Gen_Key "Preview"
'End If
Case vbKeyW
If Shift = 2 Then
Gen_Key "Set"
End If
Case vbKeyA
If Shift = 2 Then
Gen_Key "Save"
End If
Case vbKeyHome
If Shift = 2 Then
Gen_Key "FirstPage"
End If
Case vbKeyEnd
If Shift = 2 Then
Gen_Key "LastPage"
End If
Case vbKeyPageUp
If Shift = 2 Then
Gen_Key "PriorPage"
End If
Case vbKeyPageDown
If Shift = 2 Then
Gen_Key "NextPage"
End If
Case vbKeyM
If Shift = 2 Then
Gen_Key "Modify"
End If
Case vbKeyB
If Shift = 2 Then
Gen_Key "BatchPrn"
End If
Case vbKeyC
If Shift = 2 Then
Gen_Key "Seek"
End If
End Select
End Sub
Private Sub IniTxt()
If rstLXadv.RecordCount = 0 Then
txtUtName = ""
txtAccID = ""
txtChkCode = ""
txtBillCode = ""
End If
End Sub
'是否存盘
Private Sub SaveYN()
Dim i
Dim scAccID As String
Dim sDbill_date As String
Dim sdFrom As String
Dim sdTo As String
scAccID = rstLXadv![cAccId]
sDbill_date = ForDate(rstLXadv![JCR])
sdFrom = ForDate(rstLXadv![dFrom])
sdTo = ForDate(rstLXadv![dTo])
i = MsgBox("是否保存已修改的记录?", vbQuestion + vbOKCancel, zjGl_Name)
If i = vbOK Then
If edtRemark = "" Then
dbsZJ.Execute "UPDATE FD_CadAcr SET FD_CadAcr.cRemark=Null " & _
"WHERE (FD_CadAcr.cGAccID='" & scAccID & "' OR FD_CadAcr.cPAccID" & _
"='" & scAccID & "') AND FD_CadAcr.dbill_date='" & sDbill_date & "'" _
& " AND FD_CadAcr.dFrom='" & sdFrom & "' AND FD_CadAcr.dTo='" & sdTo & _
"'", dbFailOnError
Else
dbsZJ.Execute "UPDATE FD_CadAcr SET FD_CadAcr.cRemark='" & edtRemark & _
"' WHERE (FD_CadAcr.cGAccID='" & scAccID & "' OR FD_CadAcr.cPAccID" & _
"='" & scAccID & "') AND FD_CadAcr.dbill_date='" & sDbill_date & "'" _
& " AND FD_CadAcr.dFrom='" & sdFrom & "' AND FD_CadAcr.dTo='" & sdTo & _
"'", dbFailOnError
End If
rstLXadv.Requery
End If
edtRemark.Locked = True
bSave = False
End Sub
'初始化查询条件
Public Sub IniSQL()
edtRemark.Locked = True
' DisplayDate
' sSql1 = "SELECT FD_AccUnit.cUnitName AS UnitName, FD_AccDef.cAccID " & _
"AS cAccID, FD_CadAcr.dbill_date AS JCR,FD_CadAcr.dFrom,FD_CadAcr.dTo," & _
" FD_CadAcr.cBillCode AS ZDR, FD_AccSum.mh_Cad AS JS,SUM(FD_CadAcr.mmoney) AS LXE, " & _
"FD_CadAcr.cRemark AS BZ, FD_CadAcr.cCheckCode AS FH" & _
" FROM FD_Intras INNER JOIN (FD_CadAcr INNER JOIN " & _
"(FD_AccSum INNER JOIN (FD_AccDef INNER JOIN FD_AccUnit ON " & _
"FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) ON FD_AccSum.cAccID=FD_AccDef.cAccID) ON " & _
"FD_CadAcr.dbill_date=FD_AccSum.dbill_date+1) ON FD_Intras.cIntrID=FD_CadAcr.cIntrID " & _
"WHERE FD_CadAcr.iDanType=0 and FD_CadAcr.cDanID is null and (FD_CadAcr.cPAccID=FD_AccDef.cAccID OR FD_CadAcr.cGAccID=FD_AccDef.cAccID) " 'cuidong Lxd/2 2002.03.18
sSql1 = "SELECT FD_AccUnit.cUnitName AS UnitName, FD_AccDef.cAccID " & _
"AS cAccID, FD_CadAcr.dbill_date AS JCR,FD_CadAcr.dFrom,FD_CadAcr.dTo," & _
" FD_CadAcr.cBillCode AS ZDR, FD_AccSum.mh_Cad AS JS,SUM(FD_CadAcr.mmoney) AS LXE, " & _
"FD_CadAcr.cRemark AS BZ, FD_CadAcr.cCheckCode AS FH" & _
" FROM FD_Intra INNER JOIN (FD_CadAcr INNER JOIN " & _
"(FD_AccSum INNER JOIN (FD_AccDef INNER JOIN FD_AccUnit ON " & _
"FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) ON FD_AccSum.cAccID=FD_AccDef.cAccID) ON " & _
"FD_CadAcr.dbill_date=FD_AccSum.dbill_date+1) ON FD_Intra.cIntrID=FD_CadAcr.cIntrID " & _
"WHERE FD_CadAcr.iDanType=0 and FD_CadAcr.cDanID is null and (FD_CadAcr.cPAccID=FD_AccDef.cAccID OR FD_CadAcr.cGAccID=FD_AccDef.cAccID) " 'cuidong Lxd/2 2002.03.18
sSql2 = " GROUP BY FD_AccDef.cAccID, FD_AccUnit.cUnitName," & _
"FD_CadAcr.dbill_date, FD_CadAcr.cBillCode, FD_AccSum.mh_Cad, " & _
"FD_CadAcr.cRemark, FD_CadAcr.cCheckCode, FD_CadAcr.cBillCode," & _
"FD_CadAcr.dFrom,FD_CadAcr.dTo"
'生成查询语句
With Me:
.sDateStart = ForDate(.sDateStart)
.sDateEnd = ForDate(.sDateEnd)
If .sDateStart = "" And .sDateEnd <> "" Then
.edtEnd = .sDateEnd
If .sDW = "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & "'"
ElseIf .sDW = "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & _
"' AND FD_AccDef.cAccID='" & .sZH & "'"
ElseIf .sDW <> "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & _
"' AND FD_AccUnit.cUnitName='" & .sDW & "'"
ElseIf .sDW <> "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateEnd) & _
"' AND FD_AccUnit.cUnitName='" & .sDW & "'" 'ADD a Clause of edtZH
End If
ElseIf .sDateStart <> "" And .sDateEnd = "" Then
frmtzdPrn.edtStart = .sDateStart
If .sDW = "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & "'"
ElseIf .sDW = "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & _
"' AND FD_AccDef.cAccID='" & .sZH & "'"
ElseIf .sDW <> "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & _
"' AND FD_AccUnit.cUnitName='" & .sDW & "'"
ElseIf .sDW <> "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date>='" & Trim(.sDateStart) & _
"' AND FD_AccUnit.cUnitName='" & .sDW & "'" 'ADD a Clause of edtZH
End If
ElseIf .sDateStart = "" And .sDateEnd = "" Then
frmtzdPrn.edtStart = "": frmtzdPrn.edtEnd = ""
If .sDW = "" And .sZH = "" Then
sSQL = ""
ElseIf .sDW = "" And .sZH <> "" Then
sSQL = "AND FD_AccDef.cAccID='" & Trim(.sZH) & "'"
ElseIf .sDW <> "" And .sZH = "" Then
sSQL = "AND FD_AccUnit.cUnitName='" & .sDW & "'"
ElseIf .sDW <> "" And .sZH <> "" Then
sSQL = "AND FD_AccUnit.cUnitName='" & .sDW & "'" 'ADD a Clause of edtZH
End If
ElseIf .sDateStart <> "" And .sDateEnd <> "" Then
frmtzdPrn.edtStart = .sDateStart: frmtzdPrn.edtEnd = .sDateEnd
If CDate(frmtzdPrn.edtStart) = CDate(frmtzdPrn.edtEnd) Then
If .sDW = "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & "'"
ElseIf .sDW = "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & _
"' AND FD_AccDef.cAccID='" & Trim(.sZH) & "'"
ElseIf .sDW <> "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & _
"' AND FD_AccUnit.cUnitName='" & .sDW & "'"
ElseIf .sDW <> "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date='" & Trim(.sDateStart) & _
"' AND FD_AccUnit.cUnitName='" & .sDW & "'" 'ADD a Clause of edtZH
End If
Else
If .sDW = "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
"' AND '" & Trim(.sDateEnd) & "'"
ElseIf .sDW = "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
"' AND '" & Trim(.sDateEnd) & "' AND FD_AccDef.cAccID='" & _
Trim(.sZH) & "'"
ElseIf .sDW <> "" And .sZH = "" Then
sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
"' AND '" & Trim(.sDateEnd) & "' AND FD_AccUnit.cUnitName='" & _
Trim(.sDW) & "'"
ElseIf .sDW <> "" And .sZH <> "" Then
sSQL = "AND FD_CadAcr.dbill_date BETWEEN '" & Trim(.sDateStart) & _
"' AND '" & Trim(.sDateEnd) & "' AND FD_AccUnit.cUnitName='" & _
Trim(.sDW) & "'"
End If 'ADD a Clause of edtZH
End If
End If
End With
If blnPrn Then
sSQL = sSql1 & sSQL & " AND (" & prnAccID & ")" & sSql2
Else
sSQL = sSql1 & sSQL & sSql2
End If
Set rstLXadv = dbsZJ.OpenRecordset(sSQL, dbOpenDynaset)
IniTxt
FrmRefresh
SetButtonStatus
Screen.MousePointer = vbDefault
End Sub
'取选定的打印账户
Private Sub tzdPrns_ReturnAccID(blnPrint As Boolean)
Dim i As Integer, str As String
prnAccID = ""
If blnPrint And tzdPrns.List1(2).ListCount > 0 Then
With tzdPrns
For i = 0 To .List1(2).ListCount - 1
str = .List1(2).List(i)
prnAccID = prnAccID & " FD_AccDef.cAccID='" & str & "' OR"
Next i
End With
Else
prnAccID = ""
End If
If prnAccID <> "" Then prnAccID = left(prnAccID, Len(prnAccID) - 2)
blnPrn = blnPrint
End Sub
Private Sub ReSetForm()
edtStart = ""
edtEnd = ""
edtDays = ""
edtSum = ""
edtInter = ""
txtRate = ""
edtRemark = ""
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -