📄
字号:
'如果已经录入数据,则全部清空
If OptRed.Enabled = True Then
Call Sub_AddBill
End If
End Sub
Private Sub Sjcsh(Str_Pzclzt As String) '数据初始化模块(根据实际情况)
Dim Sqlstr As String '查询单据列表条件
'[>>根据实际情况初始化
Select Case Str_Pzclzt
Case "1" '填制单据
'调入用户查询结果动态集
Sqlstr = "SELECT InOutMainID From Gy_InOutMain WHERE BillCode='1211' and BillDate='" & Xtrq & "' ORDER BY InOutMainID"
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 InOutMainID From KF_V_StartStockIn a " & Str_QueryCondi & " ORDER BY InOutMainID"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
Rec_Query.Find "InOutMainId=" & Val(Lab_BillId.Caption)
Case "3" '明细帐联查单据
'设置工具条显示
With Tlb_Action
.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
'填充查询单据标识
Lab_BillId.Caption = XT_BillID
Str_QueryCondi = Xtcdcsfz
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 jsqte As Long '临时计数器
'禁止网格刷新动作,为加快网格显示速度(Fixed)
WglrGrid.Redraw = False
'本张单据查询字符串
Sqlstr = "SELECT * " & _
" FROM KF_V_StartStockIn " & _
" Where InOutMainID='" & Val(Lab_BillId.Caption) & "' Order By KF_V_StartStockIn.InOutSubID"
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
WglrGrid.Rows = WglrGrid.FixedRows
If .EOF Then
WglrGrid.Redraw = True
Exit Sub
Else
'[>>显示单据头
TextChangeLock = True '文本框加锁
LrText(0).Tag = Trim(.Fields("ReceiptID") & "") '收料通知单ID
LrText(0).Text = Trim(.Fields("ReceiptNum") & "") '收料通知单
If IsDate(.Fields("BillDate")) Then
LrText(1).Text = Format(.Fields("BillDate"), "yyyy-mm-dd") '制单日期
End If
LrText(2).Text = Trim(.Fields("BillNum") & "") '单据号
LrText(3).Tag = Trim(.Fields("WhCode") & "") '仓库编码
LrText(3).Text = Trim(.Fields("WhName") & "") '仓库名称
LrText(4).Text = Trim(.Fields("SupplierName") & "") '供应商编码
LrText(4).Tag = Trim(.Fields("SupplierCode") & "") '供应商名称
LrText(5).Tag = Trim(.Fields("InOutClassCode") & "") '入库类别编码
LrText(5).Text = Trim(.Fields("InOutClassName") & "") '入库类别名称
LrText(6).Tag = Trim(.Fields("DeptCode") & "") '部门编码
LrText(6).Text = Trim(.Fields("DeptName") & "") '部门名称
LrText(7).Tag = Trim(.Fields("PersonCode") & "") '业务员编码
LrText(7).Text = Trim(.Fields("PersonName") & "") '业务员名称
LrText(8).Tag = Trim(.Fields("TransferWayCode") & "") '运输方式编码
LrText(8).Text = Trim(.Fields("TransferWayName") & "") '运输方式名称
LrText(9).Tag = Trim(.Fields("TranCompanyCode") & "") '运输单位编码
LrText(9).Text = Trim(.Fields("TranCompanyName") & "") '运输单位名称
LrText(10).Text = Trim(.Fields("Remark") & "") '备注
LrText(11).Text = Trim(.Fields("Maker") & "") '制单人
LrText(12).Text = Trim(.Fields("KFChecker") & "") '审核人
LrText(13).Text = Trim(.Fields("ChalkitupMan") & "") '记帐人
RBFlag = .Fields("RedBlueFlag")
If .Fields("RedBlueFlag") = 0 Then
OptRed.Value = False
OptBlue.Value = True
Else
OptRed.Value = True
OptBlue.Value = False
End If
OptRed.Enabled = False
OptBlue.Enabled = False
TextChangeLock = False '文本框解锁
'<<]
End If
jsqte = WglrGrid.FixedRows
Do While Not .EOF
WglrGrid.AddItem ""
'[>>显示单据分录
WglrGrid.TextMatrix(jsqte, 0) = "*" '数据有效行标识(必填)
WglrGrid.TextMatrix(jsqte, 1) = Trim(.Fields("MArea") & "")
WglrGrid.TextMatrix(jsqte, 2) = Trim(.Fields("Ispcgl"))
WglrGrid.TextMatrix(jsqte, 3) = Trim(.Fields("Isbzqgl"))
WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Trim(.Fields("MNumber") & "") '物料编码
WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("MName") & "") '物料名称
WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("Model") & "") '物料规格
WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("PrimaryUnitName") & "") '单位
If .Fields("QuanReceipt") <> 0 Then
If OptRed.Value Then
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = 0 - .Fields("QuanReceipt") '应收数量
Else
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("QuanReceipt") '应收数量
End If
Else
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = "" '应收数量
End If
If .Fields("Price") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("Price") '单价
Else
WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = "" '单价
End If
If .Fields("EMoney") <> 0 Then
If OptRed.Value = True Then
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = 0 - Val(.Fields("EMoney")) '实际金额
Else
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = .Fields("EMoney") '实际金额
End If
Else
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = "" '实际金额
End If
If .Fields("FactReceiptQuan") <> 0 Then
If OptRed.Value = True Then
WglrGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = 0 - .Fields("FactReceiptQuan") '实际入库数量
If .Fields("PlanMoney") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = 0 - .Fields("PlanMoney") '计划金额
Else
WglrGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = "" '计划金额
End If
Else
WglrGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = .Fields("FactReceiptQuan") '实际入库数量
If .Fields("PlanMoney") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = .Fields("PlanMoney") '计划金额
Else
WglrGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = "" '计划金额
End If
End If
End If
If .Fields("PlanPrice") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = .Fields("PlanPrice") '计划单价
Else
WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = "" '计划单价
End If
'判断此物料是否进行批次和保值期管理,并隐藏或显示相应的列
If conBatch = 1 And CBool(.Fields("ispcgl")) = True Then
WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("BatchNum")) '批次
End If
If conQuan = 1 And CBool(.Fields("isbzqgl")) = True Then
WglrGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Format(Trim(.Fields("InvalidDate")), "yyyy-mm-dd") '实效日期
End If
'根据选择仓库管理方式,并隐藏或显示相应的列
If conArea = 1 Then
If CBool(.Fields("ishqgl")) = False Then
WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = True
Else
WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = False
WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("MAreaName") & "") '货区
End If
Else
WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = True
End If
'根据仓库的记价方式,隐藏或显示相应的列
PriceMode = Trim(.Fields("PriceMode"))
If Trim(.Fields("PriceMode")) <> "计划价法" Then
WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = True
WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = True
Else
WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = False
WglrGrid.ColHidden(Sydz("013", GridStr(), Szzls)) = False
End If
'<<]
WglrGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
End With
'调整网格(Fixed)
Call Sub_AdjustGrid
'计算合计数据(Fixed)
For jsqte = Qslz To WglrGrid.Cols - 1
Call Sjhj(jsqte)
Next jsqte
'将网格刷新解禁(Fixed)
WglrGrid.Redraw = True
'设置审核弃审按钮状态
If Trim(Lab_Djclzt.Caption) <> "3" Then
Call Sub_CheckStatus
End If
Call Cshhjwg
End Sub
Private Sub Timer1_Timer()
Dim jsqte As Long
'计算合计数据(Fixed)
Timer1.Enabled = False
For jsqte = Qslz To WglrGrid.Cols - 1
Call Sjhj(jsqte)
Next jsqte
On Error Resume Next
LrText(0).SetFocus
End Sub
Private Sub PrintDesign(BCol As Long, Grid As VSFlexGrid, TempCode As String)
Dim Coljsq As Integer
For Coljsq = BCol To Grid.Cols - 1
If Grid.ColHidden(Coljsq) = True Then
Cw_DataEnvi.DataConnect.Execute ("Update xt_billgridprint SET YNPrint=1 Where grid_code='" & TempCode & "' and colindex='" & Format(Coljsq - BCol + 1, "000") & "'")
Else
Cw_DataEnvi.DataConnect.Execute ("Update xt_billgridprint SET YNPrint=0 Where grid_code='" & TempCode & "' and colindex='" & Format(Coljsq - BCol + 1, "000") & "'")
End If
Next Coljsq
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
'屏蔽文本框,下拉组合框有效性判断
Valilock = True
'屏蔽网格失去焦点产生的有效性判断
Changelock = True
Select Case Button.Key
Case "yl" '预 览
If Fun_Drfrmyxxpd Then
' Call PrintDesign(Qslz, WglrGrid, GridCode)
If PriceMode = "计划价法" Then
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False, "plan"
Else
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False, "default"
End If
End If
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -