📄
字号:
Private Sub Command1_Click()
Dim Jsq As Long
Dim Dqh As Long
Dim RsTemp As New Recordset
Dim strTemp As String
Xs_I_ChoiceConsign.Show 1
If Command1.Tag <> "1" Then Exit Sub
If vsFlexGrid1.Rows = vsFlexGrid1.FixedRows Then Exit Sub
TempInvoiceConsign = "1"
strTemp = "select * from xs_v_Consignbill where ConsignCode='" & Trim(vsFlexGrid1.TextMatrix(vsFlexGrid1.FixedRows, 2)) & "'"
Set RsTemp = Cw_DataEnvi.DataConnect.Execute(strTemp)
With RsTemp
LrText(2).Tag = Trim(.Fields("CusCode") & "") '客户编码
LrText(2).Text = Trim(.Fields("cusname") & "")
LrText(3).Text = Trim(.Fields("ConsignAddress") & "") '发货地址
LrText(4).Tag = Trim(.Fields("SellTypeCode") & "") '销售类型
LrText(4).Text = Trim(.Fields("SellTypename") & "")
LrText(5).Tag = Trim(.Fields("deptCode") & "") '部门编码
LrText(5).Text = Trim(.Fields("deptname") & "")
LrText(6).Tag = Trim(.Fields("personCode") & "") '销售员
LrText(6).Text = Trim(.Fields("personname") & "")
LrText(7).Text = Trim(.Fields("Bank") & "") '开户银行
LrText(8).Text = Trim(.Fields("BankAccount") & "") '银行帐号
LrText(9).Tag = Trim(.Fields("payCode") & "") '付款条件
LrText(9).Text = Trim(.Fields("payname") & "")
LrText(10).Tag = Trim(.Fields("foreigncurrcode") & "") '币种
LrText(10).Text = Trim(.Fields("foreigncurrname") & "")
LrText(11).Text = Trim(.Fields("exchrate") & "") '汇率
LrText(11).Tag = Trim(.Fields("ConVertFlag") & "")
LrText(12).Text = Trim(.Fields("remark") & "") '备注
RsTemp.Close
End With
With WglrGrid
If GtempInvoiceHB = 1 Then
.Clear 1
.Rows = .FixedRows
For Jsq = vsFlexGrid1.FixedRows To vsFlexGrid1.Rows - 1
If vsFlexGrid1.TextMatrix(Jsq, 0) <> "*" Then Exit For
If vsFlexGrid1.TextMatrix(Jsq, 1) <> "*" Then
.Rows = .Rows + 1
Dqh = .Rows - 1
strTemp = "select * from xs_v_material where mnumber='" & Trim(vsFlexGrid1.TextMatrix(Jsq - 1, 4)) & "'"
If RsTemp.State = 1 Then RsTemp.Close
Set RsTemp = Cw_DataEnvi.DataConnect.Execute(strTemp)
.TextMatrix(Dqh, 0) = "*" '数据有效行标识(必填)
.TextMatrix(Dqh, Sydz("001", GridStr(), Szzls)) = Trim(RsTemp.Fields("mnumber") & "") '货物编码
.TextMatrix(Dqh, Sydz("002", GridStr(), Szzls)) = Trim(RsTemp.Fields("MName") & "") '货物名称
.TextMatrix(Dqh, Sydz("003", GridStr(), Szzls)) = Trim(RsTemp.Fields("Model") & "") '规格型号
.TextMatrix(Dqh, Sydz("004", GridStr(), Szzls)) = Trim(RsTemp.Fields("saleUnitName")) '单位
.TextMatrix(Dqh, Sydz("005", GridStr(), Szzls)) = Val(vsFlexGrid1.TextMatrix(Jsq, 10)) '开票数量
.TextMatrix(Dqh, Sydz("006", GridStr(), Szzls)) = Val(vsFlexGrid1.TextMatrix(Jsq, 11)) '含税单价
.TextMatrix(Dqh, Sydz("011", GridStr(), Szzls)) = Val(RsTemp.Fields("cess")) / 100 '税率
Call Sub_JoinCount(Dqh, Sydz("006", GridStr(), Szzls)) '含税单价
End If
Next
Else
.Clear 1
.Rows = .FixedRows
For Jsq = vsFlexGrid1.FixedRows To vsFlexGrid1.Rows - 1
If vsFlexGrid1.TextMatrix(Jsq, 0) <> "*" Then Exit For
If vsFlexGrid1.TextMatrix(Jsq, 1) = "*" Then
.Rows = .Rows + 1
Dqh = .Rows - 1
strTemp = "select * from xs_v_material where mnumber='" & Trim(vsFlexGrid1.TextMatrix(Jsq, 4)) & "'"
If RsTemp.State = 1 Then RsTemp.Close
Set RsTemp = Cw_DataEnvi.DataConnect.Execute(strTemp)
.TextMatrix(Dqh, 0) = "*" '数据有效行标识(必填)
.TextMatrix(Dqh, Sydz("001", GridStr(), Szzls)) = Trim(RsTemp.Fields("mnumber") & "") '货物编码
.TextMatrix(Dqh, Sydz("002", GridStr(), Szzls)) = Trim(RsTemp.Fields("MName") & "") '货物名称
.TextMatrix(Dqh, Sydz("003", GridStr(), Szzls)) = Trim(RsTemp.Fields("Model") & "") '规格型号
.TextMatrix(Dqh, Sydz("004", GridStr(), Szzls)) = Trim(RsTemp.Fields("saleUnitName")) '单位
.TextMatrix(Dqh, Sydz("005", GridStr(), Szzls)) = Val(vsFlexGrid1.TextMatrix(Jsq, 10)) '开票数量
.TextMatrix(Dqh, Sydz("006", GridStr(), Szzls)) = Val(vsFlexGrid1.TextMatrix(Jsq, 11)) '含税单价
.TextMatrix(Dqh, Sydz("011", GridStr(), Szzls)) = Val(RsTemp.Fields("cess")) / 100 '税率
Call Sub_JoinCount(Dqh, Sydz("006", GridStr(), Szzls)) '含税单价
End If
Next
End If
'重置网格
If .Rows < Pmbcsjhs + .FixedRows Then
.Rows = Pmbcsjhs + .FixedRows + Fzxwghs + 1
End If
For Jsq = .FixedRows To .Rows - 1
.RowHeight(Jsq) = Sjhgd
Next Jsq
Changelock = True
.Select .FixedRows, Qslz
Changelock = False
'----------
For Jsq = Qslz To WglrGrid.Cols - 1
Call Sjhj(Jsq)
Next Jsq
End With
End Sub
Private Sub Form_KeyPress(KeyAscii As Integer) '控 制 焦 点 转 移
Dim jdzygs As Integer
jdzygs = 18 '在单据录入中,此焦点转移控制值一定小于等于文本框个数,否则网格回车键将不支持.
Select Case KeyAscii
Case vbKeyReturn
If Kjjdzy(jdzygs) Then
KeyAscii = 0
End If
Case 39 '屏蔽字符"'"
KeyAscii = 0
End Select
End Sub
Private Sub Form_Load() '窗 体 装 入
'初始化各种锁值(Fixed)
Changelock = False '网格行列改变控制锁
Gdtlock = False '滚动条滚动控制
Yxxpdlock = True '字段有效性判断锁
Hyxxpdlock = True '行有效性判断锁
Wbkbhlock = False '文本框内容改变锁
GtempInvoiceType = "Xs_I_InvoiceBill"
TempInvoiceConsign = "0"
'单据权限索引设置
Str_RightEdit = "Xs_I_InvoiceBillEdit"
Str_RightCheck = "Xs_I_InvoiceBillCheck"
Str_RightZf = "Xs_I_InvoiceBillZf"
'调入单据信息(需要修改BillCode)
BillCode = "1404"
Call Sub_ReadBillInfo(BillCode, Me, Var_Bill())
Lab_Title = Var_Bill(2)
Lab_Title.Move (Me.Width - Lab_Title.Width) / 2, 800
'报表编码
XtReportCode = Var_Bill(5)
Load Dyymctbl
'以下为文本框处理程序(Fixed)
TextGroupCode = Var_Bill(3)
Call Drwbkxx(TextGroupCode, Textvar(), Textboolean(), Textint(), Textstr()) '读入文本框录入信息
Call Wbkcsh
'调入网格并记录一些网格信息(Fixed)
GridCode = Var_Bill(4) '网格属性编码
Call BzWgcsh(WglrGrid, GridCode, GridInf(), GridBoolean(), GridInt(), GridStr())
Qslz = GridInf(1)
Sjhgd = GridInf(2)
Fzxwghs = GridInf(4)
Sfblbzkd = GridInf(5)
Shsfts = GridInf(6)
Sfxshjwg = GridInf(7)
Szzls = WglrGrid.Cols - 1
Pmbcsjhs = Int((WglrGrid.Height - WglrGrid.FixedRows * WglrGrid.RowHeight(0)) / Sjhgd) - Fzxwghs - 1
For Jsqte = WglrGrid.FixedRows To WglrGrid.Rows - 1
WglrGrid.RowHeight(Jsqte) = Sjhgd
Next Jsqte
'初始化合计网格(Fixed)
Call Cshhjwg
'单据变动置为False(Fixed)
Bln_BillChange = False
'调入数据初始化模块(Fixed)
Lab_Djclzt.Caption = Xtcdcs
Call Sjcsh(Trim(Lab_Djclzt.Caption))
End Sub
Private Sub Form_Unload(Cancel As Integer) '窗体卸载
'是否保存已修改单据
Dim YAnswer As Integer
If Lab_OperStatus.Caption = "2" Or Lab_OperStatus.Caption = "3" Then
Tsxx = "单据尚未保存,是否退出?"
YAnswer = Xtxxts(Tsxx, 2, 2)
If YAnswer <> 1 Then
Cancel = 1
Exit Sub
End If
End If
'卸载打印页面窗体
Unload Dyymctbl
'判断单据是否发生变化,并返回相应标识
If Bln_BillChange Then
Xtfhcs = "1"
Else
Xtfhcs = "0"
End If
End Sub
Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
Dim Sqlstr As String '查询单据列表条件
'[>>根据实际情况初始化
Select Case Str_Pzclzt
Case "1" '填制单据
'调入用户查询结果动态集
Sqlstr = "SELECT InvoiceBillMainID From Xs_InvoiceBillMain Where InvoiceDate='" & Xtrq & "' and InvoiceType=0 and returnflag=0 ORDER BY InvoiceBillMainID"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
'新增单据
Call Sub_AddBill
Case "2" '查询单据(单据列表)
Lab_BillId.Caption = XT_BillID
Str_QueryCondi = Xtcdcsfz
Call Sub_ShowBill
Call Sub_OperStatus("10")
'调入用户查询结果动态集
Sqlstr = "SELECT DISTINCT InvoiceBillMainID From Xs_V_InvoiceBill " & Str_QueryCondi & " ORDER BY InvoiceBillMainID"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "InvoiceBillMainID=" & Val(Lab_BillId.Caption)
Case "3" '明细帐联查单据
'设置工具条显示
Lab_BillId.Caption = XT_BillID
With Tlb_Action
.Buttons("hd").Enabled = False '货单
.Buttons("zf").Enabled = False '作废
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("fgh0").Enabled = False '分隔行
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("fgh1").Enabled = False '分隔行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
.Buttons("shsh").Enabled = False '审核
.Buttons("shqs").Enabled = False '弃审
.Buttons("fgh2").Enabled = False '分隔行
.Buttons("first").Enabled = False '首张
.Buttons("prev").Enabled = False '上张
.Buttons("next").Enabled = False '下张
.Buttons("last").Enabled = False '末张
.Buttons("fgh5").Enabled = False '分割行
End With
Call Sub_ShowBill
'设置操作状态为浏览
Lab_OperStatus.Caption = "1"
'录入文本框
For Jsqte = Max_Text_Index To 0 Step -1
LrText(Jsqte).Enabled = False
Next Jsqte
End Select
'<<]
End Sub
Private Sub Sub_ShowBill() '根据当前单据ID显示整张单据内容
'过程默认参数为当前窗体中单据ID:Lab_BillID
Dim Sqlstr As String '临时使用字符串
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim RsTemp As New ADODB.Recordset
Dim Jsqte As Long '临时计数器
'禁止网格刷新动作,为加快网格显示速度(Fixed)
WglrGrid.Redraw = False
'本张单据查询字符串
Sqlstr = "SELECT * from Xs_V_InvoiceBill where InvoiceBillMainID='" & Lab_BillId.Caption & "' order by InvoiceBillMainID,Invoicebillsubid"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
WglrGrid.Rows = WglrGrid.FixedRows
If .EOF Then
WglrGrid.Redraw = True
Exit Sub
Else
'[>>显示单据头
TextChangeLock = True '文本框加锁
If Trim(.Fields("InvoiceFlag")) Then '销售方式
Option2.Value = True
Else
Option1.Value = True
End If
LrText(0).Text = Format(.Fields("InvoiceDate"), "yyyy-mm-dd") '发票日期
LrText(1).Text = Trim(.Fields("InvoiceCode") & "") '发票单号
LrText(1).Tag = Trim(.Fields("InvoiceBillMainId") & "") '发票单ID
LrText(2).Tag = Trim(.Fields("CusCode") & "") '客户编码
LrText(2).Text = Trim(.Fields("cusname") & "")
LrText(3).Text = Trim(.Fields("DesAddress") & "") '发货地址
LrText(4).Tag = Trim(.Fields("SellTypeCode") & "") '销售类型
LrText(4).Text = Trim(.Fields("SellTypename") & "")
LrText(5).Tag = Trim(.Fields("deptCode") & "") '部门编码
LrText(5).Text = Trim(.Fields("deptname") & "")
LrText(6).Tag = Trim(.Fields("personCode") & "") '销售员
LrText(6).Text = Trim(.Fields("personname") & "")
LrText(7).Text = Trim(.Fields("Bank") & "") '开户银行
LrText(8).Text = Trim(.Fields("BankAccount") & "") '银行帐号
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -