📄 cashoutdeal.frm
字号:
VERSION 5.00
Begin VB.Form cashOutDeal
BorderStyle = 1 'Fixed Single
Caption = "更新帐户"
ClientHeight = 6705
ClientLeft = 45
ClientTop = 435
ClientWidth = 7275
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 6705
ScaleWidth = 7275
StartUpPosition = 2 '屏幕中心
Begin VB.ListBox List4
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2940
Left = 4560
TabIndex = 6
Top = 2040
Width = 1335
End
Begin VB.ListBox List3
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2940
Left = 3000
TabIndex = 5
Top = 2040
Width = 1575
End
Begin VB.CommandButton Command2
Caption = "完成"
Height = 495
Left = 4080
TabIndex = 3
Top = 5760
Width = 1695
End
Begin VB.ListBox List2
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2940
Left = 720
TabIndex = 2
Top = 2040
Width = 735
End
Begin VB.ListBox List1
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2940
Left = 1440
TabIndex = 1
Top = 2040
Width = 1575
End
Begin VB.CommandButton Command1
Caption = "更新帐户"
Height = 495
Left = 1680
TabIndex = 0
Top = 5760
Width = 1695
End
Begin VB.Frame Frame1
Height = 3975
Left = 480
TabIndex = 7
Top = 1320
Width = 6375
Begin VB.ListBox List5
Enabled = 0 'False
BeginProperty Font
Name = "宋体"
Size = 12
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 2940
Left = 5400
TabIndex = 12
Top = 720
Width = 735
End
Begin VB.Label Label6
Caption = "年数"
Height = 255
Left = 5640
TabIndex = 13
Top = 360
Width = 495
End
Begin VB.Label Label5
Caption = "是否到期"
Height = 255
Left = 4320
TabIndex = 11
Top = 360
Width = 855
End
Begin VB.Label Label4
Caption = "金额"
Height = 255
Left = 3120
TabIndex = 10
Top = 360
Width = 495
End
Begin VB.Label Label3
Caption = "到期时间"
Height = 255
Left = 1320
TabIndex = 9
Top = 360
Width = 855
End
Begin VB.Label Label2
Caption = "编号"
Height = 255
Left = 480
TabIndex = 8
Top = 360
Width = 495
End
End
Begin VB.Label Label1
Caption = "选择要更新的定期帐户号"
BeginProperty Font
Name = "宋体"
Size = 15
Charset = 134
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 2040
TabIndex = 4
Top = 480
Width = 3375
End
End
Attribute VB_Name = "cashOutDeal"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
Dim tempPoint1 As ADODB.Recordset
Dim tempPoint2 As ADODB.Recordset
Dim xiaoE As Single
Dim hBianHao As Integer
Dim daoQiShiJ As Date
Dim DcunRuShiJ As Date
Dim fuJia As Integer
Dim todayT As Date
todayT = Date
fuJia = 1 '1表示已取出
Dim i As Integer
Dim j As Integer
Dim c(100) As Integer '存放记帐编号
Dim LCount As Integer '选择栏项目
Dim bianHao As Integer ' 编号
LCount = List2.ListCount
j = 0
For i = 0 To LCount - 1
If List2.Selected(i) Then
c(j) = List2.List(i)
j = j + 1
End If
Next i
For i = 0 To j - 1
bianHao = c(i)
textSQL = "select * from 定期帐户信息 where 编号 =" & Str(bianHao)
Set tempPoint1 = ExecuteSQL(textSQL)
DcunRuShiJ = tempPoint1.Fields(2)
xiaoE = tempPoint1.Fields(5)
daoQiShiJ = tempPoint1.Fields(3)
tempPoint1.Fields(7) = fuJia
tempPoint1.Update
tempPoint1.Close
textSQL = "select * from 活期帐户信息 where 活期帐户号 ='" & huoQiZhhh2 & "'"
Set tempPoint2 = ExecuteSQL(textSQL)
tempPoint2.MoveLast
hBianHao = tempPoint2.Fields(0)
hBianHao = hBianHao + 1
tempPoint2.AddNew
tempPoint2.Fields(0) = hBianHao
tempPoint2.Fields(1) = huoQiZhhh2
If (Today - daoQiShiJ) > 0 Then
tempPoint2.Fields(2) = daoQiShiJ '+++
Else
tempPoint2.Fields(2) = DcunRuShiJ
End If
tempPoint2.Fields(4) = xiaoE
tempPoint2.Update
tempPoint2.Close
textSQL = "select * from 帐户信息 where 帐号 ='" & ID_Number & "'"
Set tempPoint1 = ExecuteSQL(textSQL)
tempPoint1.Fields(4) = tempPoint1.Fields(4) + xiaoE
tempPoint1.Fields(5) = tempPoint1.Fields(5) - xiaoE
tempPoint1.Update
tempPoint1.Close
Next i
If j > 0 Then
MsgBox "帐户定期转入活期完成", vbOKOnly + vbExclamation, ""
End If
Unload Me
cashOutForm2.Show
End Sub
Private Sub Command2_Click()
Unload Me
LoginSucceeded = False
End Sub
Private Sub Form_Load()
Dim textSQL As String
Dim tempPoint1 As ADODB.Recordset
Dim tempPoint2 As ADODB.Recordset
Dim DZhangHao As String
Dim DYuE As Single
Dim DDaoQi As Single
Dim todayT As Date
todayT = Date
textSQL = " select * from 定期帐户信息 where 定期帐户号 ='" & dingQiZhhh2 & "'"
Set tempPoint2 = ExecuteSQL(textSQL)
Do While Not tempPoint2.EOF
If (tempPoint2.Fields(7) = 0) Then
If ((todayT - tempPoint2.Fields(3)) >= 0) Then
List4.AddItem "到期"
Else
List4.AddItem ""
End If
daoQiShiJ = tempPoint2.Fields(3)
bianH = tempPoint2.Fields(0)
List1.AddItem daoQiShiJ
List2.AddItem bianH
List3.AddItem tempPoint2.Fields(5)
List5.AddItem tempPoint2(6)
End If
tempPoint2.MoveNext
Loop
tempPoint2.Close
End Sub
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -