📄 单位利息汇总.frm
字号:
VERSION 5.00
Object = "{A0C292A3-118E-11D2-AFDF-000021730160}#1.0#0"; "UFEDIT.OCX"
Begin VB.Form frmInterSum
BorderStyle = 1 'Fixed Single
Caption = "单位利息汇总"
ClientHeight = 3540
ClientLeft = 930
ClientTop = 3030
ClientWidth = 6210
HelpContextID = 88000075
Icon = "单位利息汇总.frx":0000
LinkTopic = "Form1"
LockControls = -1 'True
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 3540
ScaleWidth = 6210
StartUpPosition = 2 '屏幕中心
Begin VB.CommandButton Command2
Height = 365
Index = 1
Left = 4965
Style = 1 'Graphical
TabIndex = 9
Top = 930
Width = 1080
End
Begin VB.CommandButton Command2
Default = -1 'True
Height = 360
Index = 0
Left = 4965
Style = 1 'Graphical
TabIndex = 8
Top = 240
Width = 1080
End
Begin VB.Frame Frame1
Caption = "请输入查询条件"
Height = 3225
Left = 225
TabIndex = 2
Top = 135
Width = 4575
Begin VB.ListBox List1
BackColor = &H00FFFFFF&
Height = 2160
Left = 300
Style = 1 'Checkbox
TabIndex = 3
Top = 795
Width = 3945
End
Begin VB.CommandButton Command1
Height = 285
Index = 1
Left = 3975
Style = 1 'Graphical
TabIndex = 7
TabStop = 0 'False
Top = 345
Width = 270
End
Begin VB.CommandButton Command1
Height = 285
Index = 0
Left = 2265
Style = 1 'Graphical
TabIndex = 6
TabStop = 0 'False
Top = 345
Width = 270
End
Begin EDITLib.Edit edtDateEnd
Height = 270
Left = 2820
TabIndex = 1
Top = 345
Width = 1140
_Version = 65536
_ExtentX = 2011
_ExtentY = 476
_StockProps = 253
ForeColor = 0
BackColor = 16777215
Appearance = 1
Property = 5
MaxLength = 10
End
Begin EDITLib.Edit edtDateStart
Height = 270
Left = 1110
TabIndex = 0
Top = 345
Width = 1140
_Version = 65536
_ExtentX = 2011
_ExtentY = 476
_StockProps = 253
ForeColor = 0
BackColor = 16777215
Appearance = 1
Property = 5
MaxLength = 10
End
Begin VB.Label Label2
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "--"
Height = 180
Left = 2595
TabIndex = 5
Top = 390
Width = 180
End
Begin VB.Label Label1
AutoSize = -1 'True
BackStyle = 0 'Transparent
Caption = "起止时间"
Height = 180
Left = 300
TabIndex = 4
Top = 390
Width = 720
End
End
End
Attribute VB_Name = "frmInterSum"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
'========================================
' 软件著作权: 北京用友软件（集团）有限公司
' 系统名称: 资金计息8.0
' 功能说明: 单位利息汇总查询
' 作者: 江 宁
'========================================
Public StartDate As String
Public EndDate As String
Public s As String
Private Sub Command1_Click(Index As Integer)
Select Case Index
Case 0: DisplayCalendar edtDateStart, Me.hWnd, Frame1.Left, Frame1.Top
Case 1: DisplayCalendar edtDateEnd, Me.hWnd, Frame1.Left, Frame1.Top
End Select
End Sub
Private Sub Command2_Click(Index As Integer)
StartDate = edtDateStart
EndDate = edtDateEnd
Dim frm As Form
Dim bOpen As Boolean
Dim sDstart As String
Dim sDend As String
Select Case Index
Case 0:
If edtDateStart <> "" And edtDateEnd <> "" Then
sDstart = ForDate(edtDateStart)
sDend = ForDate(edtDateEnd)
If Not IsDate(sDstart) Then
Beep
MsgBox "日期非法，请检查！", vbInformation, zjGl_Name
SetTxtFocus edtDateStart
Exit Sub
End If
If Not IsDate(sDend) Then
Beep
MsgBox "日期非法，请检查！", vbInformation, zjGl_Name
SetTxtFocus edtDateEnd
Exit Sub
End If
If CDate(sDstart) > CDate(sDend) Then
MsgBox "起息日期不能大于结息日期!", vbInformation, zjGl_Name
SetTxtFocus edtDateStart
Exit Sub
End If
If Not edtDateStart >= ZjAccInfo.zjStartdate Then
Beep
MsgBox "起始日期不能小于帐户的启用日期" & Format(ZjAccInfo.zjStartdate, "Long Date") & " ", vbCritical, zjGl_Name
SetTxtFocus edtDateStart
Exit Sub
End If
ElseIf edtDateStart = "" Then
MsgBox "起息日期不能为空!", vbInformation, zjGl_Name
edtDateStart.SetFocus
Exit Sub
ElseIf edtDateEnd = "" Then
MsgBox "结息日期不能为空!", vbInformation, zjGl_Name
edtDateEnd.SetFocus
Exit Sub
End If
UnitNames
Me.Hide
bOpen = False
For Each frm In Forms
If frm.Caption = "单位利息汇总表" Then
frmInterSumRep.UnitInterSum
bOpen = True
BringWindowToTop frmInterSumRep.hWnd
End If
Next
If bOpen = False Then frmInterSumRep.Show
Unload Me
Exit Sub
Case 1:
Unload Me
End Select
End Sub
'检查日期合法性
Private Sub edtDateStart_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF2 Then
Command1(0).Value = True
edtDateStart.SetFocus
End If
End Sub
Private Sub edtDateStart_LostFocus()
If edtDateStart <> "" Then
edtDateStart = ForDate(edtDateStart)
If IsDate(edtDateStart) Then
edtDateStart = FormatDate(edtDateStart)
Else
MsgBox "日期非法，请检查！", vbInformation, zjGl_Name
SetTxtFocus edtDateStart
End If
End If
End Sub
Private Sub edtDateEnd_KeyDown(KeyCode As Integer, Shift As Integer)
If KeyCode = vbKeyF2 Then
Command1(1).Value = True
edtDateEnd.SetFocus
End If
End Sub
Private Sub edtDateEnd_LostFocus()
If edtDateEnd <> "" Then
edtDateEnd = ForDate(edtDateEnd)
If IsDate(edtDateEnd) Then
edtDateEnd = FormatDate(edtDateEnd)
Else
MsgBox "日期非法，请检查！", vbInformation, zjGl_Name
SetTxtFocus edtDateEnd
End If
End If
End Sub
'取ListBox选中的项目
Private Sub UnitNames()
Dim i As Integer
s = ""
For i = 0 To List1.ListCount - 1
If List1.Selected(i) Then
List1.ListIndex = i
s = s & " FD_AccUnit.cUnitName='" & List1.Text & "' OR"
End If
Next i
If s <> "" Then s = Left(s, Len(s) - 2)
End Sub
Private Sub Form_Load()
Dim rstUnitN As New UfRecordset
Dim iRecNum As Integer
Dim sSQL As String
Me.Icon = LoadResPicture(109, vbResIcon)
Command1(0).Picture = LoadResPicture(1108, vbResBitmap)
Command1(1).Picture = LoadResPicture(1108, vbResBitmap)
Command2(0).Picture = LoadResPicture(103, vbResBitmap)
Command2(1).Picture = LoadResPicture(104, vbResBitmap)
'装载有利息业务的账户
'----zcl change
' sSQL = "SELECT DISTINCT FD_AccUnit.cUnitName FROM FD_Intras INNER JOIN (FD_CadAcr " & _
"INNER JOIN (FD_AccSum INNER JOIN (FD_AccDef INNER JOIN FD_AccUnit ON " & _
"FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) ON FD_AccSum.cAccID=FD_AccDef.cAccID) " & _
"ON FD_CadAcr.dbill_date-1=FD_AccSum.dbill_date) ON FD_Intras.cIntrID=FD_CadAcr.cIntrID," & _
"FD_AccSet INNER JOIN code ON FD_AccSet.cCode=code.cCode Where (FD_CadAcr.cPAccID " & _
"= FD_AccDef.cAccID Or FD_CadAcr.cGAccID = FD_AccDef.cAccID) AND FD_CadAcr.cDanID IS NULL " & _
"AND FD_CadAcr.iDanType=0"
sSQL = "SELECT DISTINCT FD_AccUnit.cUnitName FROM FD_Intras INNER JOIN (FD_CadAcr " & _
"INNER JOIN (FD_AccSum INNER JOIN (FD_AccDef INNER JOIN FD_AccUnit ON " & _
"FD_AccDef.cUnitCode=FD_AccUnit.cUnitCode) ON FD_AccSum.cAccID=FD_AccDef.cAccID) " & _
"ON FD_CadAcr.dbill_date-1=FD_AccSum.dbill_date) ON FD_Intras.cIntrID=FD_CadAcr.cIntrID" & _
" Where (FD_CadAcr.cPAccID " & _
"= FD_AccDef.cAccID Or FD_CadAcr.cGAccID = FD_AccDef.cAccID) AND FD_CadAcr.cDanID IS NULL " & _
"AND FD_CadAcr.iDanType=0"
Set rstUnitN = dbsZJ.OpenRecordset(sSQL, dbOpenSnapshot)
If rstUnitN Is Nothing Or rstUnitN.RecordCount = 0 Then
Command2(0).Enabled = False
Exit Sub
End If
On Error Resume Next
rstUnitN.MoveLast
rstUnitN.MoveFirst
On Error GoTo 0
For iRecNum = 0 To rstUnitN.RecordCount - 1
With rstUnitN:
While Not .EOF
List1.AddItem ![cUnitName]
.MoveNext
Wend
End With
Next iRecNum
InitialList
rstUnitN.oClose
Set rstUnitN = Nothing
End Sub
'初始化选项
Private Sub InitialList()
Dim i As Integer
On Error Resume Next
With List1:
For i = List1.ListCount - 1 To 0 Step -1
List1.Selected(i) = True
Next i
End With
On Error GoTo 0
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -