📄
字号:
Case "bcgs" '保存表格格式
Call Bcwggs(CxbbGrid, GridCode, GridStr())
Case "hfmrgs" '恢复默认格式
Call Hfmrgs(CxbbGrid, GridCode, GridStr())
Case "szxsxm" '设置显示项目
Call Szxsxm(CxbbGrid, GridCode)
End Select
End Sub
Private Sub SzToolbar_ButtonClick(ByVal Button As MSComctlLib.Button)
Select Case Button.Key
Case "ymsz" '页面设置
Dyymctbl.Show 1
Case "yl" '预 览
Call bbyl(True)
Case "dy" '打 印
Call bbyl(False)
Case "cx" '查 询
Xs_Icx_InvoiceList.Show 1
Case "Bill" '单 据
Call CxbbGrid_DblClick
Case "xz" '新 增
Call Sub_AddBill
Case "sc" '删 除
Call Sub_DeleteBill
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
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 Xs_Icx_InvoiceList
'生成查询条件
Str_QueryCondi = " where 1=1 and InvoiceType=0 "
For Jsqte = 0 To .LrText.count - 1
Select Case Jsqte
Case 0 '查询日期范围(起始)
If Trim(.LrText(0).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " And " & Trim(.Label1(Jsqte).Tag) & ">=' " & Trim(.LrText(0).Text) & "'"
End If
Case 1 '查询日期范围(终止)
If Trim(.LrText(1).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " And " & Trim(.Label1(0).Tag) & "<= ' " & Trim(.LrText(1).Text) & "'"
End If
Case Else
If Trim(.LrText(Jsqte).Text) <> "" Then
If .LrText(Jsqte).Tag <> "" Then
Str_QueryCondi = Str_QueryCondi & " and " & Trim(.Label1(Jsqte).Tag) & "='" & Trim(.LrText(Jsqte).Tag) & "'"
Else
Str_QueryCondi = Str_QueryCondi & " and " & Trim(.Label1(Jsqte).Tag) & "='" & Trim(.LrText(Jsqte).Text) & "'"
End If
End If
End Select
Next Jsqte
'审核状态
If Not .Opt_Check(0).Value Then
If .Opt_Check(1).Value Then
Str_QueryCondi = Str_QueryCondi & " and Checker='' "
Else
Str_QueryCondi = Str_QueryCondi & " and Checker<>'' "
End If
End If
'发票类型
If Not .Opt_Check(3).Value Then
If .Opt_Check(4).Value Then
Str_QueryCondi = Str_QueryCondi & " and ReturnFlag=0 "
Else
Str_QueryCondi = Str_QueryCondi & " and ReturnFlag=1 "
End If
End If
End With
Else
'1-"刷新"查询
If Str_QueryCondi = "" Then
Str_QueryCondi = " where 1=2 and InvoiceType=0 "
End If
End If
Sqlstr = "SELECT * FROM Xs_V_InvoiceBill " & Str_QueryCondi & " order by Invoicebillmainid,Invoicebillsubid"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With Rec_Query
CxbbGrid.Rows = CxbbGrid.FixedRows
Jsqte = CxbbGrid.FixedRows
Do While Not .EOF
CxbbGrid.AddItem ""
'[>>自定义填充内容
If Trim(.Fields("returnflag")) Then CxbbGrid.Cell(flexcpForeColor, Jsqte, 0, Jsqte, CxbbGrid.Cols - 1) = &HFF&
CxbbGrid.TextMatrix(Jsqte, 0) = .Fields("InvoiceBillMainID") '发票ID(主要用来查询定位用)
' CxbbGrid.TextMatrix(jsqte, 1) = .Fields("ReturnFlag") '发票类型（红或蓝）
CxbbGrid.TextMatrix(Jsqte, Sydz("001", GridStr(), Szzls)) = Format(.Fields("InvoiceDate"), "yyyy-mm-dd") '开票日期
CxbbGrid.TextMatrix(Jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("InvoiceCode") & "") '发票号
' CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("ConsignCode") & "") '发票号
CxbbGrid.TextMatrix(Jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("Cusname") & "") '客户名称
CxbbGrid.TextMatrix(Jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("Deptname") & "") '部门名称
CxbbGrid.TextMatrix(Jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("SellTypeName") & "") '销售员
CxbbGrid.TextMatrix(Jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("Personname") & "") '销售员
CxbbGrid.TextMatrix(Jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("Mname") & "") '货物名称
CxbbGrid.TextMatrix(Jsqte, Sydz("009", GridStr(), Szzls)) = Trim(.Fields("model") & "") '规格
CxbbGrid.TextMatrix(Jsqte, Sydz("010", GridStr(), Szzls)) = Trim(.Fields("saleunitname") & "") '单位
CxbbGrid.TextMatrix(Jsqte, Sydz("011", GridStr(), Szzls)) = Abs(.Fields("Quantity") & "") '开票数量
CxbbGrid.TextMatrix(Jsqte, Sydz("012", GridStr(), Szzls)) = Trim(.Fields("CapitalTaxUnitPrice") & "") '含税单价
CxbbGrid.TextMatrix(Jsqte, Sydz("013", GridStr(), Szzls)) = Abs(.Fields("CapitalWhole") & "") '含税金额
CxbbGrid.TextMatrix(Jsqte, Sydz("014", GridStr(), Szzls)) = Abs(.Fields("CapitalTax") & "") '税额
CxbbGrid.TextMatrix(Jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("Maker") & "") '制单人
CxbbGrid.TextMatrix(Jsqte, Sydz("016", GridStr(), Szzls)) = Trim(.Fields("Checker") & "") '审核人
CxbbGrid.TextMatrix(Jsqte, Sydz("017", GridStr(), Szzls)) = Trim(.Fields("InvalideMaker") & "") '作废人
CxbbGrid.TextMatrix(Jsqte, Sydz("018", GridStr(), Szzls)) = Trim(.Fields("CapitalUnitPrice") & "") '不含税单价
CxbbGrid.TextMatrix(Jsqte, Sydz("019", GridStr(), Szzls)) = Abs(.Fields("CapitalMoney") & "") '不含税金额
If Val(Trim(.Fields("CapitalDiscount") & "")) <> 0 Then
CxbbGrid.TextMatrix(Jsqte, Sydz("020", GridStr(), Szzls)) = Abs(.Fields("CapitalDiscount") & "") '折扣额
End If
'<<]
'设置数据行高度(Fixed)
CxbbGrid.RowHeight(Jsqte) = Sjhgd
'动态集指针加1,同时将计数器加1(Fixed)
.MoveNext
Jsqte = Jsqte + 1
Loop
End With
']以上为用户自定义部分
End Sub
Private Sub CxbbGrid_DblClick() '用户双击网格调入相应单据
Dim RecTemp As New ADODB.Recordset '临时使用动态集
'非数据行退出
If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
Exit Sub
End If
Sqlstr = "SELECT InvoiceBillMainID,returnflag From Xs_InvoiceBillMain Where InvoiceBillMainID=" & Val(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 = CxbbGrid.TextMatrix(CxbbGrid.Row, 0) '填充查询单据标识
Xtcdcs = "2" '设置单据处理为列表查询(修改)状态
'调入单据处理窗体
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
If Xtfhcs = "1" Then
Tsxx = "发票发生变化,是否刷新发票列表?"
Yhanswer = Xtxxts(Tsxx, 2, 2)
If Yhanswer = 1 Then
Xt_Wait.Show
Xt_Wait.Refresh
'加快显示速度
CxbbGrid.Redraw = False
'生成查询结果
Call Sub_Query(1)
CxbbGrid.Redraw = True
Xt_Wait.Hide
End If
End If
End If
End With
End Sub
Private Sub Sub_AddBill() '新增单据
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
'设置单据处理为填制单据状态
Xtcdcs = "1"
XS_I_InvoiceType.Show 1
If GTempAnswer = "2" Then Exit Sub
If GTempAnswer = "0" Then
Xs_I_InvoiceBill.Show 1
Else
Xs_I_RedInvoice.Show 1
End If
If Xtfhcs = "1" Then
Tsxx = "发票发生变化,是否刷新发票列表?"
Yhanswer = Xtxxts(Tsxx, 2, 2)
If Yhanswer = 1 Then
Xt_Wait.Show
Xt_Wait.Refresh
'加快显示速度
CxbbGrid.Redraw = False
'生成查询结果
Call Sub_Query(1)
CxbbGrid.Redraw = True
Xt_Wait.Hide
End If
End If
End Sub
Private Sub Sub_DeleteBill() '删除选中当前发票
Dim YAnswer As Integer
Dim Lng_BillID As Long '单据标识
'判断用户是否有此功能执行权限,如有则写上机日志(进入)
If Not Security_Log(Str_RightEdit, Xtczybm, 1, True) Then
Exit Sub
End If
'非数据行退出
If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
Exit Sub
End If
Tsxx = "请确认是否删除当前发票?"
Yhanswer = Xtxxts(Tsxx, 2, 2)
If Yhanswer = 1 Then
'1.判断当前发票是否允许删除
If Not Fun_AllowDelete Then
Exit Sub
End If
'2.删除单据所有内容
Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
On Error GoTo Swcwcl
Cw_DataEnvi.DataConnect.BeginTrans
Cw_DataEnvi.DataConnect.Execute ("Delete Xs_Invoice_Consign Where InvoiceBillMainID = " & Lng_BillID) '核销关系
Cw_DataEnvi.DataConnect.Execute ("Delete Xs_InvoiceBillSub Where InvoiceBillMainID=" & Lng_BillID) '删除单据子表内容
Cw_DataEnvi.DataConnect.Execute ("Delete Xs_InvoiceBillMain Where InvoiceBillMainID=" & Lng_BillID) '删除单据主表内容
Cw_DataEnvi.DataConnect.CommitTrans
'删除网格中单据数据
Jsqte = CxbbGrid.FixedRows
Do While Jsqte <= CxbbGrid.Rows - 1
If Val(CxbbGrid.TextMatrix(Jsqte, 0)) = Lng_BillID Then
CxbbGrid.RemoveItem (Jsqte)
Else
Jsqte = Jsqte + 1
End If
Loop
Else
Exit Sub
End If
Exit Sub
Swcwcl:
Cw_DataEnvi.DataConnect.RollbackTrans
Tsxx = "删除发票过程中出现未知错误,程序自动恢复删除前状态!"
Call Xtxxts(Tsxx, 0, 1)
Exit Sub
End Sub
Private Function Fun_AllowDelete() As Boolean '判断当前单据是否允许删除
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim Sqlstr As String '查询字符串
Dim Lng_BillID As Long '单据ID
Lng_BillID = Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0))
Sqlstr = "Select Checker From Xs_InvoiceBillMain Where InvoiceBillMainID=" & Lng_BillID
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If Not .EOF Then
If Trim(.Fields("Checker") & "") <> "" Then
Tsxx = "该发票已审核确认,不能删除!"
Call Xtxxts(Tsxx, 0, 4)
Exit Function
End If
End If
End With
Fun_AllowDelete = True
End Function
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 + -