📄
字号:
strMName = Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("002", GridStr(), Szzls)))
strMArea = Trim(WglrGrid.TextMatrix(WglrGrid.Row, 1))
strMAreaName = Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("005", GridStr(), Szzls)))
strBatch = Trim(WglrGrid.TextMatrix(WglrGrid.Row, Sydz("006", GridStr(), Szzls)))
strInfor = ""
If strWhCode <> "" Then
strInfor = strInfor & "仓库:" & strWhName & ","
End If
If strMArea <> "" Then
strInfor = strInfor & "货区:" & strMAreaName & ","
End If
If strBatch <> "" Then
strInfor = strInfor & "批次:" & strBatch & ","
End If
If strMName <> "" Then
strInfor = strInfor & "物料:" & strMName & ","
End If
If strWhCode = "" Or strMnumber = "" Then
Tsxx = "输入信息不全,无法统计现存量!"
Call Xtxxts(Tsxx, 0, 4)
Else
If KFNowQuan(strWhCode, strMnumber, strMArea, strBatch, 0, Val(Lab_BillId.Caption), dblNowQuan) = 1 Or KFNowQuan(strWhCode, strMnumber, strMArea, strBatch, 0, Val(Lab_BillId.Caption), dblNowQuan) = 0 Then
Tsxx = strInfor & "现存量为:" & dblNowQuan
Call Xtxxts(Tsxx, 0, 4)
End If
End If
End Sub
Private Sub OptBlue_Click()
If OptBlue.Enabled = True Then
Call Sub_AddBill
End If
End Sub
Private Sub OptRed_Click()
'选中红字时,调取退货单
'如果已经录入数据,则全部清空
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='1206' 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_OtherOut 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_OtherOut " & _
" Where InOutMainID='" & Val(Lab_BillId.Caption) & "' Order By KF_V_OtherOut.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 '文本框加锁
If IsDate(.Fields("BillDate")) Then
LrText(0).Text = Format(.Fields("BillDate"), "yyyy-mm-dd") '制单日期
End If
LrText(2).Text = Trim(.Fields("BillNum") & "") '单据号
LrText(1).Tag = Trim(.Fields("WhCode") & "") '仓库编码
LrText(1).Text = Trim(.Fields("WhName") & "") '仓库名称
LrText(3).Text = Trim(.Fields("OperType") & "") '业务类型
LrText(4).Text = Trim(.Fields("operbillnum") & "") '业务单号
LrText(6).Tag = Trim(.Fields("DeptCode") & "") '部门编码
LrText(6).Text = Trim(.Fields("DeptName") & "") '部门名称
LrText(5).Tag = Trim(.Fields("InOutClassCode") & "") '入库类别编码
LrText(5).Text = Trim(.Fields("InOutClassName") & "") '入库类别名称
LrText(7).Tag = Trim(.Fields("personCode") & "") '业务员
LrText(7).Text = Trim(.Fields("PersonName") & "") '业务员名称
LrText(8).Text = Trim(.Fields("Remark") & "") '备注
LrText(9).Text = Trim(.Fields("Maker") & "") '制单人
LrText(10).Text = Trim(.Fields("KFChecker") & "") '审核人
LrText(11).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("Price") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("Price") '单价
Else
WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = "" '单价
End If
If .Fields("IssueMoney") <> 0 Then
If OptRed.Value = True Then
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = 0 - Val(.Fields("IssueMoney")) '数量
Else
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = .Fields("IssueMoney") '数量
End If
Else
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = "" '数量
End If
If .Fields("FactIssueQuan") <> 0 Then
If OptRed.Value = True Then
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = 0 - .Fields("FactIssueQuan") '实际出库数量
If .Fields("PlanMoney") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = 0 - .Fields("PlanMoney") '计划金额
Else
WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = "" '计划金额
End If
Else
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("FactIssueQuan") '实际出库数量
If .Fields("PlanMoney") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = .Fields("PlanMoney") '计划金额
Else
WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = "" '计划金额
End If
End If
End If
If .Fields("PlanPrice") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = .Fields("PlanPrice") '计划单价
Else
WglrGrid.TextMatrix(jsqte, Sydz("011", 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 tempQuan = 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("011", GridStr(), Szzls)) = True
WglrGrid.ColHidden(Sydz("012", GridStr(), Szzls)) = True
Else
WglrGrid.ColHidden(Sydz("011", GridStr(), Szzls)) = False
WglrGrid.ColHidden(Sydz("012", 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 Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
'屏蔽文本框,下拉组合框有效性判断
Valilock = True
'屏蔽网格失去焦点产生的有效性判断
Changelock = True
Select Case Button.Key
Case "yl" '预 览
If Fun_Drfrmyxxpd Then
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -