⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frmdataenv.frm

📁 金融机构用于银行承兑票台帐的登记以及统计打印各种报表
💻 FRM
📖 第 1 页 / 共 3 页
字号:
End Sub

Private Sub Combo4_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Combo5.SetFocus
End If
End Sub

Private Sub Combo5_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Combo6.SetFocus
End If
End Sub

Private Sub Combo6_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Combo7.SetFocus
End If
End Sub

Private Sub Combo7_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Command1_Click
End If
End Sub

Public Sub Command1_Click()
If 版本状态 = 1 Then
GoTo eee
End If
If 版本状态 = 2 Or 动态库存量 >= 限制数 Then '当为到期版本时
MsgBox "版本到期!无法添加数据,欢迎与我们联系注册,详情请查看[帮助]内容中[进行用户注册]相关内容。", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
eee:
Dim rc, rcc, rccc As Date
Dim a, b, c, d As Integer
If Val(Text1.Text) = 0 Then
MsgBox "承兑金额不得为空值!", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
'ElseIf Val(Text1.Text) < 0 And Combo7.Text <> "冲帐" Then
'MsgBox "只有冲帐时承兑金额才能为负值!", vbOKOnly Or vbInformation, "系统信息"
'Exit Sub
'ElseIf Val(Text1.Text) > 0 And Combo7.Text = "冲帐" Then
'MsgBox "进行冲帐时承兑金额需为负值!", vbOKOnly Or vbInformation, "系统信息"
'Exit Sub
End If
With ycdck.Adodc1
'检查承兑申请人和承兑经办人是否已开户
.RecordSource = "select * from 承兑申请人 where 承兑申请人=" & "'" & Combo1.Text & "'"
.Refresh
c = .Recordset.RecordCount
If c = 0 Then
MsgBox "承兑申请人" & Combo1.Text & "还未设置,无法添加。", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
.RecordSource = "select * from 申请经办人 where 申请经办人=" & "'" & Combo6.Text & "'"
.Refresh
d = .Recordset.RecordCount
If d = 0 Then
MsgBox "承兑经办人" & Combo6.Text & "还未设置,无法添加。", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
'检查结束
'求最大编号
Dim aa, bb As Integer
aa = 0
bb = 0
.RecordSource = "select 自动编号 from 台帐录入 order by id"
.Refresh
If Not (.Recordset.EOF And .Recordset.BOF) Then
.Recordset.MoveLast
aa = .Recordset.Fields(0).Value
End If
.RecordSource = "select 自动编号 from 台帐数据 order by id"
.Refresh
If Not (.Recordset.EOF And .Recordset.BOF) Then
.Recordset.MoveLast
bb = .Recordset.Fields(0).Value
End If
If aa > bb Then
cc = aa + 1
ElseIf aa < bb Then
cc = bb + 1
ElseIf aa = 0 And bb = 0 Then
cc = 1
End If
End With
With Adodc1
.Recordset.AddNew
.Recordset.Fields(1).Value = Me.Combo1.Text
If Combo7.Text = "冲帐" Then
.Recordset.Fields(2).Value = Val(Me.Text1.Text) * (-1)
Else
.Recordset.Fields(2).Value = Val(Me.Text1.Text)
End If
.Recordset.Fields(3).Value = Me.Text2.Text
.Recordset.Fields(4).Value = Format(Me.DTPicker1.Value, "yyyy-m-d")
If Combo2.Text = "其它" Then
.Recordset.Fields(5).Value = Format(Me.DTPicker2.Value, "yyyy-m-d")
GoTo cde
End If
rccc = Me.DTPicker1.Value
Select Case Combo2.Text
Case "一个月"
rc = DateSerial(Year(rccc), Month(rccc) + 1, Day(rccc))
Case "二个月"
rc = DateSerial(Year(rccc), Month(rccc) + 2, Day(rccc))
Case "三个月"
rc = DateSerial(Year(rccc), Month(rccc) + 3, Day(rccc))
Case "六个月"
rc = DateSerial(Year(rccc), Month(rccc) + 6, Day(rccc))
End Select
If Day(rc) <> Day(rccc) Then
a = 27
rc = DateSerial(Year(rc), Month(rc) - 1, a)
b = Month(rc)
Do
rcc = rc
a = a + 1
rc = DateSerial(Year(rc), Month(rc), a)
If Month(rc) > b Then
rc = rcc
Exit Do
End If
Loop
End If
.Recordset.Fields(5).Value = Format(rc, "yyyy-m-d")
cde:
.Recordset.Fields(11).Value = Me.Combo2.Text
.Recordset.Fields(6).Value = Me.Combo3.Text
.Recordset.Fields(7).Value = Me.Combo4.Text
.Recordset.Fields(8).Value = Me.Combo5.Text
.Recordset.Fields(9).Value = Me.Combo6.Text
.Recordset.Fields(10).Value = Me.Combo7.Text
.Recordset.Fields(14).Value = cc
.Recordset.Update
.Refresh
.Recordset.MoveLast
Me.DTPicker1.Refresh
End With
'恢复默认设置值
Me.Combo1.Text = Com1
Me.Combo2.Text = Com2
Me.DTPicker1.Value = Dt1
Me.Combo5.Text = Com5
Me.Combo6.Text = Com6
Combo3.Text = ""
Combo4.Text = ""
Combo7.Text = ""
Text1.Text = ""
Text2.Text = ""
Me.Text1.SetFocus
'增加记录数
If 版本状态 = 0 Then '当为试用版本时
With frmLogin.Adodc1
.RecordSource = "select * from zyj"
.Refresh
记录数 = 记录数 + 1
.Recordset.Fields(1).Value = 记录数
.Recordset.Update
'何时到期
   If 记录数 >= 限制数 Then
   .Recordset.Fields(2).Value = 2
   .Recordset.Update
   版本状态 = 2
   End If
End With
End If
动态库存量 = 动态库存量 + 1
End Sub


Private Sub Command10_Click()
With ycdck.Adodc1
.RecordSource = "select * from 台帐数据"
.Refresh
If .Recordset.RecordCount = 0 Then
MsgBox "历史数据为零!", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
End With
frmlsjl.Show 1
End Sub

Private Sub Command11_Click()
X = MsgBox("此操作将解除对[提交]和[添加]功能的限制,要解除吗?", vbOKCancel Or vbQuestion, "系统信息")
If X = vbOK Then
frmDataEnv.Text3 = 0
frmDataEnv.Text4 = 1
End If
End Sub

Private Sub Command2_Click()
Dim num As Integer
num = Adodc1.Recordset.RecordCount
If num > 0 Then
   X = MsgBox("确实要删除选定记录吗?", vbOKCancel Or vbQuestion, "系统信息")
   If X = vbOK Then
   Adodc1.Recordset.Delete
   Else
   Exit Sub
   End If
ElseIf num = 0 Then
MsgBox "没有要删除的记当录", vbOKOnly Or vbInformation, "系统信息"
End If
End Sub

Private Sub Command3_Click()
Adodc2.RecordSource = "select 承兑申请人 from 台帐录入 group by 承兑申请人 order by 承兑申请人"
Adodc2.Refresh
If Adodc2.Recordset.RecordCount = 0 Then
MsgBox "没有要打印的数据", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
Do
Cdsqr = Adodc2.Recordset.Fields(0).Value
Adodc1.RecordSource = "select * from 台帐录入 where 承兑申请人=" & "'" & Cdsqr & "'"
Adodc1.Refresh
Dayinshu = Adodc1.Recordset.RecordCount
Dytz '打印台帐(调用公用代码)
Adodc2.Recordset.MoveNext
If Adodc2.Recordset.EOF = True Then
Exit Do
End If
Loop
Adodc1.RecordSource = "select * from 台帐录入"  '恢复ADODC1的原来连接,使GRID里面能显示所有数据
Adodc1.Refresh
Adodc1.Recordset.MoveLast
Text3.Text = 1
Text4.Text = 1
'DataReport1.Show 1
End Sub

Private Sub Command4_Click()
X = MsgBox("确实要提交数据吗?", vbOKCancel Or vbQuestion, "系统信息")
If X = vbCancel Then
Exit Sub
End If
If Adodc1.Recordset.RecordCount = 0 Then
MsgBox "没有要提交的数据!", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
Text4.Text = 0
Text3.Text = 0
Adodc1.Recordset.Close
Adodc1.Recordset.Open "insert into 台帐数据 select * from 台帐录入"
Adodc1.Refresh
Adodc1.Recordset.Close
Adodc1.Recordset.Open "delete * from 台帐录入"
Adodc1.Refresh
Adodc1.Recordset.Close
Adodc1.RecordSource = "select * from 台帐录入"
Adodc1.Refresh

End Sub

Private Sub Command5_Click()
Unload Me
End Sub

Private Sub Command6_Click()
frmstiao.Show 1
End Sub

Private Sub Command7_Click()
选择排序方式.Show 1
End Sub

Private Sub Command8_Click()
With ycdck.Adodc1
.RecordSource = "select * from 台帐数据"
.Refresh
If .Recordset.RecordCount = 0 Then
MsgBox "数据库为空值!", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
End With
frmfanhuan.Show 1
End Sub

Private Sub Command9_Click()
With ycdck.Adodc1
.RecordSource = "select * from 台帐录入"
.Refresh
If .Recordset.RecordCount = 0 Then
MsgBox "数据为空!", vbOKOnly Or vbInformation, "系统信息"
Exit Sub
End If
End With
With 统计
.Option1(0).Value = True
.Text1(0).Text = ""
.Text1(1).Text = ""
.Label5.Caption = ""
.Label6.Caption = ""
.Command3.Enabled = False
.Command1.Enabled = True
End With
With ycdck.Adodc1
.RecordSource = "select min(出票日期) as min出票日期,max(出票日期) as max出票日期 from 台帐录入"
.Refresh
统计.DTPicker1.Value = .Recordset.Fields(0).Value
统计.DTPicker2.Value = .Recordset.Fields(1).Value
.RecordSource = "select * from 申请经办人 order by 申请经办人"
.Refresh
If .Recordset.RecordCount > 0 Then
.Recordset.MoveFirst
Do While Not .Recordset.EOF
统计.Combo1.AddItem .Recordset.Fields(1).Value
.Recordset.MoveNext
Loop
End If
End With
统计.Show 1
End Sub

Private Sub DTPicker1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Combo2.SetFocus
End If
End Sub

Private Sub Form_Activate()
If frmDataEnv.Adodc1.Recordset.RecordCount > 0 Then
frmDataEnv.Adodc1.Recordset.MoveLast
End If
Screen.MousePointer = 0
Me.DTPicker1.Value = Now
'记下默认设置值
Com1 = Combo1.Text
Dt1 = Me.DTPicker1.Value
Com2 = Me.Combo2.Text
Com5 = Me.Combo5.Text
Com6 = Me.Combo6.Text
End Sub

Private Sub Form_Load()
With ycdck.Data7.Recordset   '定义报表边距
For i = 1 To 4
Bj(i) = .Fields(i).Value
Next i
End With
End Sub

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 46 Then
Exit Sub
End If
If KeyAscii = 13 Then
Text2.SetFocus
End If
If KeyAscii = 8 Then
Exit Sub
ElseIf KeyAscii < 48 Or KeyAscii > 57 Then
Beep
KeyAscii = 0
End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Me.Combo2.SetFocus
End If
End Sub

Private Sub Text3_Change()
If Text3.Text = 0 Then
Command1.Enabled = True
ElseIf Text3.Text = 1 Then
Command1.Enabled = False
End If
End Sub

Private Sub Text4_Change()
If Text4.Text = 1 Then
Command4.Enabled = True
ElseIf Text4.Text = 0 Then
Command4.Enabled = False
End If
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -