📄 +
字号:
'填充表头部门内容
BadDebt_FrmLossList.Lab_Cust.Caption = "客户: " & .LrText(0).Text
BadDebt_FrmLossList.Lab_Cust.Tag = Trim(.LrText(0).Tag)
'生成查询条件
Str_QueryCondi = " where 1=1 and RPFlag = 'AR' and BillItemCode like '[1-2]%' and YbYsje>YbCancelJe"
For jsqte = 1 To 4
Select Case jsqte
Case 1 '客户
If Trim(.LrText(0).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " and PsCode = '" & Trim(.LrText(0).Tag) & "'"
End If
Case 2 '币别
If Trim(.LrText(1).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " And ForeignCurrCode='" & Trim(.LrText(1).Tag) & "'"
End If
Case 3 '部门
If Trim(.LrText(2).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " And DeptCode= '" & Trim(.LrText(2).Tag) & "'"
End If
Case 4 '经办人
If Trim(.LrText(3).Text) <> "" Then
Str_QueryCondi = Str_QueryCondi & " And PersonCode= '" & Trim(.LrText(3).Tag) & "'"
End If
End Select
Next jsqte
End With
Else
'1-"刷新"查询
End If
Sqlstr = "SELECT * FROM Ar_v_AccMxList " & Str_QueryCondi & " Order By BillDate,BillCode"
Set Rec_Query = Cw_DataEnvi.DataConnect.Execute(Sqlstr)
With Rec_Query
WglrGrid.Rows = WglrGrid.FixedRows
jsqte = WglrGrid.FixedRows
Do While Not .EOF
WglrGrid.AddItem ""
'[>>自定义填充内容
WglrGrid.TextMatrix(jsqte, 0) = "*"
WglrGrid.TextMatrix(jsqte, Sydz("001", GridStr(), Szzls)) = False '选择
WglrGrid.TextMatrix(jsqte, Sydz("002", GridStr(), Szzls)) = "" '摘要
WglrGrid.TextMatrix(jsqte, Sydz("003", GridStr(), Szzls)) = Trim((.Fields!BillItemName) & "") '单据类型名称
WglrGrid.TextMatrix(jsqte, Sydz("018", GridStr(), Szzls)) = Trim((.Fields!BillItemCode) & "") '单据类型编号
WglrGrid.TextMatrix(jsqte, Sydz("004", GridStr(), Szzls)) = Trim((.Fields!BillCode) & "") '单据号
WglrGrid.TextMatrix(jsqte, Sydz("005", GridStr(), Szzls)) = Format(.Fields!BillDate, "yyyy-mm-dd") '单据日期
If Val(Trim((.Fields!VouchNo) & "")) <> 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("006", GridStr(), Szzls)) = Trim((.Fields("VouchClassCode") & "")) & "-" & Trim(.Fields!VouchNo) '凭证号
End If
WglrGrid.TextMatrix(jsqte, Sydz("007", GridStr(), Szzls)) = Trim((.Fields!DeptCode) & "") '部门编码
WglrGrid.TextMatrix(jsqte, Sydz("008", GridStr(), Szzls)) = Trim((.Fields!DeptName) & "") '部门名称
WglrGrid.TextMatrix(jsqte, Sydz("009", GridStr(), Szzls)) = Trim((.Fields!PersonCode) & "") '经办人编码
WglrGrid.TextMatrix(jsqte, Sydz("010", GridStr(), Szzls)) = Trim((.Fields!PersonName) & "") '经办人
WglrGrid.TextMatrix(jsqte, Sydz("011", GridStr(), Szzls)) = Trim((.Fields!ForeignCurrCode) & "") '币别编码
WglrGrid.TextMatrix(jsqte, Sydz("012", GridStr(), Szzls)) = Trim((.Fields!ForeignCurrName) & "") '币别名称
If Val(.Fields!YbYsje) - Val(.Fields!YbCancelje) > 0 Then
WglrGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) = Val(.Fields!YbYsje) - Val(.Fields!YbCancelje) '原币余额
End If
WglrGrid.TextMatrix(jsqte, Sydz("014", GridStr(), Szzls)) = Val(.Fields!AccRate) '记帐汇率
WglrGrid.TextMatrix(jsqte, Sydz("015", GridStr(), Szzls)) = WglrGrid.TextMatrix(jsqte, Sydz("013", GridStr(), Szzls)) '原币坏帐余额
WglrGrid.TextMatrix(jsqte, Sydz("017", GridStr(), Szzls)) = Val(.Fields!BbYsje) - Val(.Fields!BbCancelje) '本币坏帐余额
WglrGrid.TextMatrix(jsqte, Sydz("016", GridStr(), Szzls)) = Trim((.Fields!AccCodeArAp) & "") '应收科目编码
'<<]
'设置数据行高度(Fixed)
WglrGrid.RowHeight(jsqte) = Sjhgd
'动态集指针加1,同时将计数器加1(Fixed)
.MoveNext
jsqte = jsqte + 1
Loop
End With
'将网格刷新解禁(Fixed)
WglrGrid.Redraw = True
']以上为用户自定义部分
End Sub
Private Sub Timer1_Timer() '在窗体激活后调入查询程序
Me.Timer1.Enabled = False
Me.Visible = True
Call Sub_Search
End Sub
Private Sub Sub_Search() '首次加载调用查询条件
BadDebt_FrmLossQuery.Show 1
If UCase(Trim(BadDebt_FrmLossQuery.Tag)) = "TRUE" Then
'生成查询结果
Call Sub_Query(0)
Else
BadDebt_FrmLossQuery.UnloadCheck.Value = 1
Unload BadDebt_FrmLossQuery
Unload Me
End If
End Sub
Private Sub Tlb_Action_ButtonClick(ByVal Button As MSComctlLib.Button) '用户点击工具条
'屏蔽文本框,下拉组合框有效性判断
Valilock = True
'屏蔽网格失去焦点产生的有效性判断
changelock = True
Select Case Button.Key
Case "ymsz" '页面设置
Dyymctbl.Show 1
Case "yl" '预 览
If Fun_Drfrmyxxpd Then
Call bbyl(True)
End If
Case "dy" '打 印
If Fun_Drfrmyxxpd Then
Call bbyl(False)
End If
Case "cx" '查 询
BadDebt_FrmLossQuery.Show 1
'生成查询结果
If UCase(Trim(BadDebt_FrmLossQuery.Tag)) = "TRUE" Then Call Sub_Query(0)
Case "qx" '全 选
Call Sub_WgSelect(0)
Case "qq" '全 消
Call Sub_WgSelect(1)
Case "pz" '凭 证
If Fun_Drfrmyxxpd Then
Call Sub_SaveBill
End If
Case "bz" '帮 助
Call F1bz
Case "fh" '退 出
Unload Me
End Select
'解 锁
Valilock = False
changelock = False
End Sub
Private Sub Sub_WgSelect(Xzzt As Integer)
Dim jsqte As Integer
Dim TmpJsq As Integer
'非数据行退出
If WglrGrid.Rows = WglrGrid.FixedRows Then
Exit Sub
End If
jsqte = WglrGrid.Rows - WglrGrid.FixedRows
With WglrGrid
Select Case Xzzt
Case 0 '当选择全选时选中所有记录
For TmpJsq = .FixedRows To jsqte
.TextMatrix(TmpJsq, Sydz("001", GridStr(), Szzls)) = True
Next TmpJsq
Case 1 '当选择全选时放弃所有记录
For TmpJsq = .FixedRows To jsqte
.TextMatrix(TmpJsq, Sydz("001", GridStr(), Szzls)) = False
Next TmpJsq
End Select
End With
End Sub
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer) '支持热键操作
If Shift = 2 Then
Select Case UCase(Chr(KeyCode))
Case "P" 'Ctrl+P 打印
If Tlb_Action.Buttons("dy").Enabled Then
Call bbyl(False)
End If
End Select
End If
End Sub
Private Sub Wbkcl() '文本框录入之前处理(根据实际情况)
Dim xswbrr As String
With WglrGrid
Zdlrqnr = Trim(.Text)
xswbrr = Trim(.Text)
If GridBoolean(.Col, 3) Then '列表框录入
'填充列表框程序
Call FillCombo(YdCombo, GridStr(.Col, 5), xswbrr, 0)
Else
Wbkbhlock = True
'====以下为用户自定义
Ydtext.Text = xswbrr
'====以上为用户自定义
Wbkbhlock = False
Ydtext.SelStart = Len(Ydtext.Text)
End If
End With
End Sub
Private Function sjzdyxxpd(Dqpdwgh As Long, Dqpdwgl As Long) '录入数据字段有效性判断,同时进行字段录入事后处理
Dim Str_JudgeText As String '临时有效性判断字段内容
Dim Coljsq As Long '临时列计数器
Dim RecTemp As New ADODB.Recordset '临时使用动态集
Dim Dbl_Qcye As Double '临时期初余额
Dim ForCode As String '币别编码
Dim YbJe As Single '原币金额
Dim Rate As Single '记帐汇率
Dim Dbl_Bbje As Single '计算本币金额
Dim Bln_ConVertFlag As Boolean '汇率记帐方式
Dim Dbl_AccRate As Double '根据币别获取记帐汇率
With WglrGrid
'非录入状态有效性为合法
If Yxxpdlock Or .Row < .FixedRows Then
sjzdyxxpd = True
Exit Function
End If
Str_JudgeText = Trim(.TextMatrix(Dqpdwgh, Dqpdwgl))
Select Case GridStr(Dqpdwgl, 1)
'以下为自定义部分[
'1.放置字段有效性判断程序
Case "015"
YbJe = Val(.TextMatrix(Dqpdwgh, Sydz("015", GridStr(), Szzls))) '原币金额
Rate = Val(.TextMatrix(Dqpdwgh, Sydz("014", GridStr(), Szzls))) '记帐汇率
ForCode = Trim(.TextMatrix(Dqpdwgh, Sydz("011", GridStr(), Szzls))) '币别编码
Call Sub_GetAccRate(ForCode, Bln_ConVertFlag, Dbl_AccRate) '根据币别获取记帐汇率
If YbJe > Val(.TextMatrix(Dqpdwgh, Sydz("013", GridStr(), Szzls))) Then
Tsxx = "坏帐金额不能大于余额!"
GoTo Lrcwcl
End If
If Bln_ConVertFlag Then
If YbJe <> 0 And Rate <> 0 Then
Dbl_Bbje = Val(Format(Val(YbJe / Rate), "##." + String(Xtjexsws, "0")))
Else
Dbl_Bbje = 0
End If
Else
Dbl_Bbje = Val(Format(Val(YbJe * Rate), "##." + String(Xtjexsws, "0")))
End If
.TextMatrix(Dqpdwgh, Sydz("017", GridStr(), Szzls)) = Dbl_Bbje '计算本币坏帐金额
'2.放置字段事后处理程序
'以上为自定义部分]
End Select
'字段录入正确后为零字段清空
Call Qkwlzd(Dqpdwgh, Dqpdwgl)
sjzdyxxpd = True
Yxxpdlock = True
Exit Function
End With
Lrcwcl: '录入错误处理
With WglrGrid
Call Xtxxts(Tsxx, 0, 1)
changelock = True
.Select Dqpdwgh, Dqpdwgl
changelock = False
Call xswbk
sjzdyxxpd = False
Exit Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -