📄
字号:
'本张单据查询字符串
Sqlstr = "SELECT * " & _
" FROM KF_V_Start " & _
" Where StartMainId='" & Val(Lab_BillId.Caption) & "' Order By KF_V_Start.StartSubId"
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).Text = Trim(.Fields("BillNum"))
LrText(1).Text = Trim(.Fields("whname") & "")
LrText(1).Tag = Trim(.Fields("whcode") & "")
LrText(2).Tag = Trim(.Fields("SupplierCode") & "")
LrText(2).Text = Trim(.Fields("SupplierName") & "")
LrText(3).Tag = Trim(.Fields("DeptCode") & "")
LrText(3).Text = Trim(.Fields("DeptName") & "")
LrText(4).Tag = Trim(.Fields("PersonCode") & "")
LrText(4).Text = Trim(.Fields("PersonName") & "")
LrText(5).Text = Trim(.Fields("ChalkitupMan") & "")
TextChangeLock = False '文本框解锁
'<<]
If Val(conArea) <> 0 Then
If .Fields("ishqgl") Then
WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = False
Else
WglrGrid.ColHidden(Sydz("005", GridStr(), Szzls)) = True
End If
End If
End If
jsqte = WglrGrid.FixedRows
Do While Not .EOF
WglrGrid.AddItem ""
'[>>显示单据分录
WglrGrid.TextMatrix(jsqte, 0) = "*"
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") & "")
WglrGrid.TextMatrix(jsqte, 2) = .Fields("ispcgl")
WglrGrid.TextMatrix(jsqte, 3) = .Fields("isbzqgl")
WglrGrid.TextMatrix(jsqte, 1) = Trim(.Fields("MArea") & "")
If Not IsNull(.Fields("MAreaName")) Then
WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = .Fields("MAreaName") '
End If
If Not IsNull(.Fields("BatchNum")) Then
WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = .Fields("BatchNum") '
End If
If .Fields("Quan") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = .Fields("Quan")
End If
If .Fields("Price") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = .Fields("Price") '
End If
If .Fields("EMoney") <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = .Fields("EMoney") '
End If
If Not IsNull(.Fields("InvalidDate")) Then
WglrGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = .Fields("InvalidDate") '
End If
'<<]
B_Flag = .Fields("ispcgl") Or B_Flag
Q_Flag = .Fields("isbzqgl") Or Q_Flag
WglrGrid.RowHeight(jsqte) = Sjhgd
.MoveNext
jsqte = jsqte + 1
Loop
If Val(conBatch) <> 0 Then
If B_Flag Then
WglrGrid.ColHidden(Sydz("006", GridStr(), Szzls)) = False
Else
WglrGrid.ColHidden(Sydz("006", GridStr(), Szzls)) = True
End If
End If
If Val(conQuan) <> 0 Then
If Q_Flag Then
WglrGrid.ColHidden(Sydz("010", GridStr(), Szzls)) = False
Else
WglrGrid.ColHidden(Sydz("010", GridStr(), Szzls)) = True
End If
End If
End With
'调整网格(Fixed)
Call Sub_AdjustGrid
'计算合计数据(Fixed)
For jsqte = Qslz To WglrGrid.Cols - 1
Call Sjhj(jsqte)
Next jsqte
'将网格刷新解禁(Fixed)
WglrGrid.Redraw = True
'设置审核弃审按钮状态
Call Cshhjwg
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
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, False
End If
Case "dy" '打 印
If Fun_Drfrmyxxpd Then
Dim Yhanswer As Integer '打印提示
'用户确认是否打印单据
Tsxx = "请确认是否打印当前单据?"
Yhanswer = Xtxxts(Tsxx, 2, 2)
If Yhanswer = 2 Then
Exit Sub
End If
BillGridPrint WglrGrid, LrText, GridStr(), Szzls, GridCode, TextGroupCode, XtReportCode, True
End If
Case "xz" '新 增
Call Sub_AddBill
Case "xg" '修 改
Call Sub_EditBill
Case "sc" '删 除
Call Sub_DeleteBill
Case "zh" '增 行
Call zjlrfl
Case "sh" '删 行
Call Scdqfl
Case "bc" '保 存
If Fun_Drfrmyxxpd Then
Call Sub_SaveBill
End If
Case "fq" '放 弃
Call Sub_AbandonBill
Case "first" '首 张
Call Sub_First
Case "prev" '上 张
Call Sub_Prev
Case "next" '下 张
Call Sub_next
Case "last" '末 张
Call Sub_Last
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
End Select
'解 锁
Valilock = False
Changelock = False
TextChangeLock = False
End Sub
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) '支持热键操作
Select Case KeyCode
Case vbKeyF5 '增加单据
If Tlb_Action.Buttons("xz").Enabled And Tlb_Action.Buttons("xz").Visible Then
Call Sub_AddBill
End If
Case vbKeyF3 '修改单据
If Tlb_Action.Buttons("xg").Enabled And Tlb_Action.Buttons("xg").Visible Then
Call Sub_EditBill
End If
Case vbKeyF6 '保存单据
If Tlb_Action.Buttons("bc").Enabled And Tlb_Action.Buttons("bc").Visible Then
If Fun_Drfrmyxxpd Then Call Sub_SaveBill
End If
End Select
End Sub
Private Sub Sub_OperStatus(Str_Status As String) '工具条依据不同状态所进行的变化
With Tlb_Action
Select Case Str_Status
Case "10" '浏览((列表)调入单据处理时的进入状态、(列表)新增状态时放弃录入)
'工具条
.Buttons("dy").Enabled = True '打印
.Buttons("yl").Enabled = True '预览
If CheckStartFinish = True Then
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
Else
.Buttons("xz").Enabled = True '新增
.Buttons("xg").Enabled = True '修改
.Buttons("sc").Enabled = True '删除
End If
.Buttons("zh").Enabled = False '增行
.Buttons("sh").Enabled = False '删行
.Buttons("bc").Enabled = False '保存
.Buttons("fq").Enabled = False '放弃
.Buttons("first").Enabled = True '首张
.Buttons("prev").Enabled = True '上张
.Buttons("next").Enabled = True '下张
.Buttons("last").Enabled = True '末张
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
'设置审核弃审按钮状态
'设置文本框录入状态
Call Sub_LrtextStatus(False)
Case "20" '新增单据(（录入）新增一张单据 、（列表）新增一张单据)
'工具条
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("zh").Enabled = True '增行
.Buttons("sh").Enabled = True '删行
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
.Buttons("first").Enabled = False '首张
.Buttons("prev").Enabled = False '上张
.Buttons("next").Enabled = False '下张
.Buttons("last").Enabled = False '末张
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
'设置文本框录入状态
Call Sub_LrtextStatus(True)
Case "30" '修改(（录入）调入修改功能、（列表）调入修改功能)
'工具条
.Buttons("dy").Enabled = False '打印
.Buttons("yl").Enabled = False '预览
.Buttons("xz").Enabled = False '新增
.Buttons("xg").Enabled = False '修改
.Buttons("sc").Enabled = False '删除
.Buttons("zh").Enabled = True '增行
.Buttons("sh").Enabled = True '删行
.Buttons("bc").Enabled = True '保存
.Buttons("fq").Enabled = True '放弃
.Buttons("first").Enabled = False '首张
.Buttons("prev").Enabled = False '上张
.Buttons("next").Enabled = False '下张
.Buttons("last").Enabled = False '末张
.Buttons("bz").Enabled = True '帮助
.Buttons("fh").Enabled = True '退出
'设置文本框录入状态
Call Sub_LrtextStatus(True)
End Select
End With
End Sub
Private Sub Sub_LrtextStatus(TextEnabled As Boolean) '设置录入文本框状态
'录入文本框状态设置
If TextEnabled Then
For jsqte = Max_Text_Index To 0 Step -1
'判断文本框是否可编辑
If Textboolean(jsqte, 5) Then
LrText(jsqte).Enabled = True
Else
LrText(jsqte).Enabled = False
End If
Next jsqte
Else
For jsqte = Max_Text_Index To 0 Step -1
LrText(jsqte).Enabled = False
Next jsqte
End If
End Sub
Private Sub Wbkcl() '文本框录入之前处理(根据实际情况)
Dim xswbrr As String
With WglrGrid
Zdlrqnr = Trim(.Text)
xswbrr = Trim(.Text)
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -