📄 -
字号:
End If
Case 12 '审核状态
If Not .OptCheck(0).Value Then
If .OptCheck(1).Value Then
Str_QueryCondi = Str_QueryCondi & " and KfChecker='' "
Else
Str_QueryCondi = Str_QueryCondi & " and KfChecker<>'' "
End If
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 * From KF_V_MateIn " & Str_QueryCondi & " Order By KF_V_MateIn.InOutMainID"
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) = Val(.Fields("InOutMainID")) '单据ID
CxbbGrid.TextMatrix(jsqte, 1) = Val(.Fields("InvoiceID") & "") '发票ID
CxbbGrid.TextMatrix(jsqte, 2) = Trim(.Fields("InvoiceNum") & "") '发票号
CxbbGrid.TextMatrix(jsqte, 3) = Trim(.Fields("suppliercode")) '供应商
CxbbGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = Format(.Fields("BillDate"), "yyyy-mm-dd") '单据日期
CxbbGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = Trim(.Fields("WhName") & "") '仓库
CxbbGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim(.Fields("BillNum") & "") '单据号
CxbbGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim(.Fields("InvoiceNum") & "") '发票
CxbbGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Trim(.Fields("DeptName") & "") '部门
CxbbGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim(.Fields("MNumber") & "") '物料编码
CxbbGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim(.Fields("MName") & "") '物料名称
CxbbGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Trim(.Fields("Model") & "") '规格型号
If .Fields("planprice") <> 0 Then
CxbbGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = .Fields("planprice") '计划价
End If
If .Fields("FactReceiptQuan") <> 0 Then
CxbbGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = .Fields("FactReceiptQuan") '入库数量
End If
If .Fields("price") <> 0 Then
CxbbGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = .Fields("price") '价格
End If
If .Fields("emoney") <> 0 Then
CxbbGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = .Fields("emoney") '金额
End If
If .Fields("planmoney") <> 0 Then
CxbbGrid.TextMatrix(jsqte, Sydz("016", GridStr(), Szzls)) = .Fields("planmoney") '计划金额
End If
CxbbGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Trim(.Fields("maker") & "") '制单人
CxbbGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = Trim(.Fields("KfChecker") & "") '审核
CxbbGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = Trim(.Fields("ChalkItupMan") & "") '记帐
CxbbGrid.TextMatrix(jsqte, Sydz("017", GridStr(), Szzls)) = Trim(.Fields("suppliername") & "") '供应商
'<<]
'设置数据行高度(Fixed)
CxbbGrid.RowHeight(jsqte) = Sjhgd
'动态集指针加1,同时将计数器加1(Fixed)
.MoveNext
jsqte = jsqte + 1
Loop
End With
CxbbGrid.SelectionMode = flexSelectionListBox
']以上为用户自定义部分
End Sub
Private Sub CxbbGrid_DblClick() '用户双击网格调入相应单据
Dim RecTemp As New ADODB.Recordset '临时使用动态集
'当第一次查询结果为空时,判断总记录行是否与固定行数相同,如相同则出现错误(双表头出现此情况)
If CxbbGrid.Rows = CxbbGrid.FixedRows Then
Exit Sub
End If
'非数据行退出
If CxbbGrid.Row < CxbbGrid.FixedRows Or Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 0)) = 0 Then
Exit Sub
End If
Sqlstr = "SELECT InOutMainID From gy_inOutMain Where InOutMainID=" & 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)
Xtcdcsfz = Str_QueryCondi
'设置单据处理为列表查询(修改)状态
Xtcdcs = "2"
With KF_FrmMateIn
'填充查询单据标识
.Show 1
End With
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 Judge_NowDate = False Then Exit Sub
With KF_FrmMateIn
'设置单据处理为填制单据状态
Xtcdcs = "1"
.Show 1
End With
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 CxbbGrid.Rows = CxbbGrid.FixedRows 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 gy_inOutSub Where InOutMainID=" & Lng_BillID) '删除单据子表内容
Cw_DataEnvi.DataConnect.Execute ("Delete gy_inOutMain Where InOutMainID=" & Lng_BillID) '删除单据主表内容
Cw_DataEnvi.DataConnect.Execute ("update Cg_InvoiceMain set BanlanceDate=null,BanlanPeriod=null,BanlanKjYear=null where InvoiceMainID=" & Val(CxbbGrid.TextMatrix(CxbbGrid.Row, 1)) & " and InvoiceNum='" & Trim(CxbbGrid.TextMatrix(CxbbGrid.Row, 2)) & "'")
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 kfChecker,ChalkItupMan From gy_inOutMain Where InOutMainID=" & Lng_BillID
Set RecTemp = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With RecTemp
If Not .EOF Then
If Trim(.Fields("kfChecker") & "") <> "" Or Trim(.Fields("ChalkItupMan") & "") <> "" 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
Private Sub Sub_HX()
Dim Int_Year As Integer
Dim Int_Period As Integer
TxtRq.Text = Format(Xtrq, "yyyy-mm-dd")
If CheckBillDate(TxtRq, Int_Year, Int_Period) = True Then
Exit Sub
End If
If StrTemp2 <> "" Then
Cw_DataEnvi.DataConnect.Execute ("update gy_inoutSub set balancedate='" & Format(Xtrq, "yyyy-mm-dd") & "' , balanceyear=" & Int_Year & " , balanceperiod=" & Int_Period & " where InOutMainID in(" & StrTemp1 & ") and InOutSubID in(" & StrTemp2 & ")")
Tsxx = "材料入库单核销完毕!"
Call Xtxxts(Tsxx, 0, 4)
StrTemp2 = ""
StrTemp1 = ""
End If
End Sub
Private Sub Sub_QX()
Dim Int_Year As Integer
Dim Int_Period As Integer
If StrTemp2 <> "" Then
Cw_DataEnvi.DataConnect.Execute ("update gy_inoutSub set balancedate=NULL , balanceyear=NULL , balanceperiod=null where InOutMainID in(" & StrTemp1 & ") and InOutSubID in(" & StrTemp2 & ")")
Tsxx = "材料入库单弃销完毕!"
Call Xtxxts(Tsxx, 0, 4)
StrTemp2 = ""
StrTemp1 = ""
End If
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -