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

📄 account.cls

📁 主要是基本的家庭理财管理操作界面, 包括基本信息管理、理财信息管理、数据统计管理等。
💻 CLS
字号:
VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "Account"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'1 AccountNo 文本 长度 50 账户
'2 AType 文本 长度 50  帐户类型:储蓄、工资、负债、信用卡
'3 BId  数字 银行编号
'4 MemId 数字 成员编号
'5 OpenDate  文本 长度 50 开户日期
'6 Flag 数字 字节 存款类型:0-活期、1-定期
'7 ASum 数字 单精度型 帐户金额
'8 Memos 文本 长度 200 备注

Public AccountNo As String
Public AType As String
Public BId As Long
Public MemId As Long
Public OpenDate As String
Public Flag As Integer
Public ASum As Double
Public Memos As String

Public Sub Init()
  AccountNo = ""
  AType = "储蓄"
  BId = 0
  MemId = 0
  OpenDate = ""
  Flag = 0
  ASum = 0
  Memos = ""
End Sub

'删除
Public Sub Delete(ByVal TmpANo As String)
  SqlStmt = "DELETE FROM Account WHERE AccountNo='" + Trim(TmpANo) + "'"
  SQLExt (SqlStmt)
End Sub

Public Function GetInfo(ByVal TmpANo As String) As Boolean
  Dim rs As New ADODB.Recordset  '定义结果集对象
  
  '设置SELECT语句,读取编号为TmpANo的记录
  SqlStmt = "SELECT * FROM Account WHERE AccountNo='" + Trim(TmpANo) + "'"
  '将结果集读取到rs中
  Set rs = QueryExt(SqlStmt)

  If rs.EOF Then
    '如果结果集为空,则初始化
    Init
    GetInfo = False
  Else
    '将结果集中的数据赋值到成员变量中
    If IsNull(rs.Fields(0)) Then
      AccountNo = ""
    Else
      AccountNo = Trim(rs.Fields(0))
    End If
   
    If IsNull(rs.Fields(1)) Then
      AType = ""
    Else
      AType = Trim(rs.Fields(1))
    End If
    If IsNull(rs.Fields(2)) Then
      BId = 0
    Else
      BId = rs.Fields(2)
    End If
    If IsNull(rs.Fields(3)) Then
      MemId = 0
    Else
      MemId = rs.Fields(3)
    End If
    If IsNull(rs.Fields(4)) Then
      OpenDate = ""
    Else
      OpenDate = Trim(rs.Fields(4))
    End If
    If IsNull(rs.Fields(5)) Then
      Flag = 0
    Else
      Flag = rs.Fields(5)
    End If
    If IsNull(rs.Fields(6)) Then
      ASum = 0
    Else
      ASum = rs.Fields(6)
    End If
    If IsNull(rs.Fields(7)) Then
      Memos = ""
    Else
      Memos = Trim(rs.Fields(7))
    End If
    GetInfo = True
  End If
End Function

'插入分类
Public Sub Insert()
  SqlStmt = "INSERT INTO Account(AccountNo,AType,BId,MemId,OpenDate,Flag,ASum,Memos)" _
       + " VALUES('" + Trim(AccountNo) + "','" + Trim(AType) _
       + "'," + Trim(BId) + "," + Trim(MemId) _
       + ",'" + Trim(OpenDate) + "'," + Trim(Flag) _
       + "," + Trim(ASum) + ",'" + Trim(Memos) + "')"
  SQLExt (SqlStmt)
End Sub

'更新数据
Public Sub Update(ByVal TmpANo As String)
   SqlStmt = "UPDATE Account SET AType='" + Trim(AType) _
          + "',BId=" + Trim(BId) + ",MemId=" + Trim(MemId) _
          + ",OpenDate='" + Trim(OpenDate) + "',Flag=" + Trim(Flag) _
          + ",ASum=" + Trim(ASum) + ",Memos='" + Trim(Memos) _
          + "' Where AccountNo = '" + Trim(TmpANo) + "'"
  SQLExt (SqlStmt)
End Sub
'更新帐户金额
Public Sub UpdateSum(ByVal TmpANo As String, ByVal TmpFlag As Integer, ByVal OSum As Double)
  If TmpFlag = 2 Then
    SqlStmt = "UPDATE Account SET ASum=0 Where AccountNo = '" + Trim(TmpANo) + "'"
  Else
    SqlStmt = "UPDATE Account SET ASum=ASum+" + Trim(OSum) _
          + " Where AccountNo = '" + Trim(TmpANo) + "'"
  End If
  SQLExt (SqlStmt)
End Sub

'计算现金帐户金额和非现金帐户金额
Public Function CalSum(ByVal TmpFlag As Integer) As Double
  Dim rs As New ADODB.Recordset  '定义结果集对象
  
  If TmpFlag = 0 Then  '现金帐户
    SqlStmt = "SELECT Sum(ASum) FROM Account WHERE AType Like '%现金%'"
  Else
    SqlStmt = "SELECT Sum(ASum) FROM Account WHERE AType Not Like '%现金%'"
  End If
  '将结果集读取到rs中
  Set rs = QueryExt(SqlStmt)

  If IsNull(rs.Fields(0)) Then
    CalSum = 0
  Else
    CalSum = rs.Fields(0)
  End If
End Function

⌨️ 快捷键说明

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