📄 ˪-i
字号:
If Trim(.Fields("returnflag")) Then
Xtcdcsfz = Str_QueryCondi & " and returnflag = 1"
Xs_I_RedInvoice.Show 1
Else
Xtcdcsfz = Str_QueryCondi & " and returnflag = 0"
Xs_I_InvoiceBill.Show 1
End If
End If
End With
Case "专用发票"
Sqlstr = "SELECT InvoiceBillMainID,returnflag From Xs_InvoiceBillMain Where InvoiceBillMainID='" & CxbbGrid.TextMatrix(CxbbGrid.Row, 0) & "'"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If .EOF Then
Tsxx = "此发票已被其他用户删除!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Else
XT_BillID = Val(RecTemp.Fields!InvoiceBillMainID) '填充查询单据标识
Xtcdcs = "3" '设置单据处理为列表查询(修改)状态
'调入单据处理窗体
If Trim(.Fields("returnflag")) Then
Xtcdcsfz = Str_QueryCondi & " and returnflag = 1"
Xs_I_UseRedInvoice.Show 1
Else
Xtcdcsfz = Str_QueryCondi & " and returnflag = 0"
Xs_I_UseInvoice.Show 1
End If
End If
End With
End Select
End Sub
Private Sub Timer1_Timer() '在窗体激活后调入查询程序
Timer1.Enabled = False
Xt_Wait.Show
Xt_Wait.Refresh
'加快显示速度
CxbbGrid.Redraw = False
'生成查询结果
Call Sub_Query(0)
CxbbGrid.Redraw = True
Xt_Wait.Hide
End Sub
Private Sub Sub_Query(Int_QueryType As Integer) '生成查询结果(Define)
'过程参数:Int_QueryType 0-"点确定按钮"查询 1-"刷新"查询
Dim Rec_Query As New ADODB.Recordset '查询结果动态集
Dim Coljsq As Long '网格列计数器
Dim jsqte As Long '临时动态计数器
'以下为自定义部分[
If Int_QueryType = 0 Then '0-"点确定按钮"查询
With ArNote_FrmFpgzcxtj
'生成查询条件
Str_QueryCondi = " Where 1=1 "
For jsqte = 1 To 3
Select Case jsqte
Case 1 '查询日期范围(起始)
If Trim(.LrText(0).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " And a.InvoiceDate>=' " & Trim(.LrText(0).Text) & "'"
End If
Case 2 '查询日期范围(终止)
If Trim(.LrText(1).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " And a.InvoiceDate<= ' " & Trim(.LrText(1).Text) & "'"
End If
Case 3 '客户
If Trim(.LrText(2).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " and a.CusCode = '" & Trim(.LrText(2).Tag) & "'"
End If
End Select
Next jsqte
End With
Else
'1-"刷新"查询
If Str_QueryCondi = "" Then
Str_QueryCondi = " where 1=2 "
End If
End If
Sqlstr = "SELECT a.*,Gy_Person.PersonName,Gy_Customer.CusName,Gy_ForeignCurrency.ForeignCurrName" & _
" FROM XS_InvoiceBillMain a LEFT OUTER JOIN " & _
" Gy_Customer ON a.CusCode = Gy_Customer.CusCode LEFT OUTER JOIN " & _
" Gy_Person ON a.PersonCode = Gy_Person.PersonCode LEFT OUTER JOIN " & _
" Gy_ForeignCurrency ON a.ForeignCurrCode = Gy_ForeignCurrency.ForeignCurrCode " & Str_QueryCondi & " And InvoiceFlag=1 And ArBookFlag=0 And Checker<>'' And InvalideMaker='' Order By InvoiceDate,InvoiceCode"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With Rec_Query
CxbbGrid.Rows = CxbbGrid.FixedRows
jsqte = CxbbGrid.FixedRows
Do While Not .EOF
CxbbGrid.AddItem ""
'[>>自定义填充内容
CxbbGrid.TextMatrix(jsqte, 0) = .Fields("InvoiceBillMainID") '发票主表ID
CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = False '选中
CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Format(.Fields("InvoiceDate"), "yyyy-mm-dd") '单据日期
If Trim(.Fields("InvoiceType") & "") = "0" Then
CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = "普通发票" '普通发票
Else
CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = "专用发票" '专用发票
End If
CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("InvoiceCode") & "") '发票号
CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("CusName") & "") '客户
CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("ForeignCurrName") & "") '币别
If .Fields("NowValueFor") <> 0 Then '原币金额
CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("NowValueFor")
End If
If .Fields("NowValue") <> 0 Then '本币金额
CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("NowValue")
End If
CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("PersonName") & "") '业务员
CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("Maker") & "") '制单人
CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim(.Fields("Checker") & "") '审核人
'设置数据行高度(Fixed)
CxbbGrid.RowHeight(jsqte) = Sjhgd
'动态集指针加1,同时将计数器加1(Fixed)
.MoveNext
jsqte = jsqte + 1
Loop
'<<]
End With
']以上为用户自定义部分
End Sub
'====================================以下为单据选中操作======================================'
Private Sub CxbbGrid_DblClick() '双击切换
With CxbbGrid
If .Row < .FixedRows Then
Exit Sub
End If
If CxbbGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) Then
CxbbGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = False
Else
CxbbGrid.TextMatrix(.Row, Sydz("001", GridStr(), Szzls)) = True
End If
End With
End Sub
Private Sub CxbbGrid_KeyPress(KeyAscii As Integer) '用户按空格表示切换,按回车表示选中
With CxbbGrid
If Chr(KeyAscii) = " " Then
For jsqte = .Row To .RowSel
If CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) Then
CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = False
Else
CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = True
End If
Next jsqte
End If
If KeyAscii = vbKeyReturn Then
For jsqte = .Row To .RowSel
CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = True
Next jsqte
End If
End With
End Sub
Private Sub Sub_SelectAll() '全选
With CxbbGrid
For jsqte = .FixedRows To .Rows - 1
CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = True
Next jsqte
End With
End Sub
Private Sub Sub_AbandonAll() '全消
With CxbbGrid
For jsqte = .FixedRows To .Rows - 1
CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = False
Next jsqte
End With
End Sub
'====================================以上为单据选中操作======================================'
Private Sub Sub_Sxfpgz() '赊销发票过帐
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim jsqte As Long
Dim Lng_Fpjsq As Long '选中发票计数器
Dim Int_Dqyear As Integer '用户选择会计年度
Dim Int_DqPeriod As Integer '用户选择会计期间
Dim Lng_BillID As Long '单据标识
Dim yhAnswer As Integer '回答是否确认
'判断用户选中发票张数
Lng_Fpjsq = 0
For jsqte = CxbbGrid.FixedRows To CxbbGrid.Rows - 1
If CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) Then
Lng_Fpjsq = Lng_Fpjsq + 1
End If
Next jsqte
If Lng_Fpjsq = 0 Then
Tsxx = "请先选中过帐发票!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
End If
'判断用户所选业务日期与当前会计期间是否一致
Sqlstr = "Select Top 1 * FROM Gy_Kjrlb Where ArJzbz=0 Order By Kjyear,Period"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If Not .EOF Then
If Not (Xtrq >= .Fields("Qsrq") And Xtrq <= .Fields("Zzrq")) Then
Tsxx = "业务日期应在当前会计期间范围内!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
Else
Int_Dqyear = .Fields("Kjyear")
Int_DqPeriod = .Fields("Period")
End If
Else
Tsxx = "所有会计期间已结帐完毕!"
Call Xtxxts(Tsxx, 0, 4)
Exit Sub
End If
End With
'让用户确认是否过帐选中发票
Tsxx = "请确认是否将选中发票过帐到" & Mid(Trim(Str(10000 + Int_Dqyear)), 2, 4) & "." & Mid(Trim(Str(100 + Int_DqPeriod)), 2, 2) & "会计期间?"
yhAnswer = Xtxxts(Tsxx, 2, 2)
If yhAnswer = 2 Then
Exit Sub
End If
'销售发票过帐
For jsqte = CxbbGrid.FixedRows To CxbbGrid.Rows - 1
If CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) Then
Lng_BillID = Val(CxbbGrid.TextMatrix(jsqte, 0))
If Not Fun_AccInvoiceBill(Lng_BillID, Int_Dqyear, Int_DqPeriod) Then
Exit Sub
End If
End If
Next jsqte
'过帐完毕,刷新网格
Xt_Wait.Show
Xt_Wait.Refresh
'加快显示速度
CxbbGrid.Redraw = False
'生成查询结果
Call Sub_Query(1)
CxbbGrid.Redraw = True
Xt_Wait.Hide
Tsxx = "销售发票过帐完毕!"
Call Xtxxts(Tsxx, 0, 4)
End Sub
Private Sub bbyl(bbylte As Boolean) '报表打印预览
Dim Bbzbt$, Bbxbt() As String, bbxbtzzxs() As Integer, Bbxbtgs As Integer
Dim Bbbwh() As String, Bbbwhzzxs() As Integer, Bbbwhgs As Integer
Bbxbtgs = 1 '报 表 小 标 题 行 数
Bbbwhgs = 0 '报 表 表 尾 行 数
ReDim Bbxbt(1 To Bbxbtgs)
ReDim bbxbtzzxs(1 To Bbxbtgs)
If Bbbwhgs <> 0 Then
ReDim Bbbwh(1 To Bbbwhgs)
ReDim Bbbwhzzxs(1 To Bbbwhgs)
End If
Bbzbt = ReportTitle
Bbxbt(1) = " "
bbxbtzzxs(1) = 0 '报表行组织形式(0-居左 1-居中 2-居右)
Call Scyxsjb(CxbbGrid) '生成报表数据
Call Scdybb(Dyymctbl, Bbzbt, Bbxbt(), bbxbtzzxs(), Bbxbtgs, Bbbwh(), Bbbwhzzxs(), Bbbwhgs, bbylte)
If Not bbylte Then
Unload DY_Tybbyldy
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -