📄 databas.bas
字号:
Attribute VB_Name = "DataBas"
Option Explicit
Private Type ColDsec
Type As Long
Name As String
Digit As Integer
End Type
Private Type CellText
tCol As Long
tRow As Long
tText As String
tType As Long
tDigit As Integer
End Type
Private Type CellDesc
MaxCol As Integer
MaxRow As Integer
CurCol As Long
CurRow As Long
ColData() As ColDsec
Text() As CellText
End Type
Private Type CmdShow
Save_Cmd As Boolean
Prnt_Cmd As Boolean
Find_Cmd As Boolean
End Type
Public meObj As New EditTable.EditTableCls
Public meCell As CellDesc
Public CmdState As CmdShow
Public selTableName As String
Public Sub InitRith()
Dim MsgInfo As String
With CmdState
'//保存权限 权限ID:16
.Save_Cmd = meObj.BaseInfo.getUserRight(meObj.BaseInfo.getUserID, 21, MsgInfo)
'//打印权限
.Prnt_Cmd = meObj.BaseInfo.getUserRight(meObj.BaseInfo.getUserID, 19, MsgInfo)
'//搜索权限
.Find_Cmd = meObj.BaseInfo.getUserRight(meObj.BaseInfo.getUserID, 20, MsgInfo)
End With
End Sub
'//计算表格的宽度行列
Public Function getCellData(ByVal tName As String, ByRef MsgInfo As String) As Boolean
On Error GoTo ErrHandle
Dim DaCn As New ADODB.Connection
Dim DaRs As New ADODB.Recordset
Dim Sql As String
Dim iLoop As Integer
Dim jLoop As Integer
Dim iCount As Integer
Sql = "select count(*) as tCount from " & tName
DaCn.ConnectionString = meObj.BaseInfo.getConStr
DaCn.Open
DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
If Not DaRs.EOF And Not IsNull(DaRs("tCount")) Then
meCell.MaxRow = DaRs("tCount") + 1 + 1 '//系统+标题+表体
End If
DaRs.Close
'//
Sql = "select * from " & tName
DaRs.Open Sql, DaCn, adOpenStatic, adLockReadOnly
meCell.MaxCol = DaRs.Fields.Count + 1
jLoop = 0
For iLoop = 0 To DaRs.Fields.Count - 1
jLoop = jLoop + 1
ReDim Preserve meCell.ColData(1 To jLoop)
meCell.ColData(jLoop).Name = DaRs.Fields(iLoop).Name
meCell.ColData(jLoop).Type = DaRs.Fields(iLoop).Type
meCell.ColData(jLoop).Digit = DaRs.Fields(iLoop).NumericScale
Next
iCount = 0
jLoop = 1
'//
If Not DaRs.EOF Then
While Not DaRs.EOF
jLoop = jLoop + 1
For iLoop = 0 To DaRs.Fields.Count - 1
iCount = iCount + 1
ReDim Preserve meCell.Text(1 To iCount)
With meCell.Text(iCount)
.tCol = iLoop + 1
.tRow = jLoop
If Not IsNull(DaRs(iLoop)) Then
.tText = DaRs(iLoop)
.tType = DaRs(iLoop).Type
.tDigit = DaRs(iLoop).NumericScale
Else
.tType = meCell.ColData(iLoop).Type
Select Case .tType
Case 3, 4, 5, 6, 11, 17, 20, 128, 131, 204 '//数值
.tText = "0"
Case 129, 135, 200, 201, 202, 203 '//字符
.tText = ""
End Select
End If
End With
Next
DaRs.MoveNext
Wend
End If
'//
DaRs.Close
DaCn.Close
Set DaRs = Nothing
Set DaCn = Nothing
MsgInfo = "数据初始化完成"
getCellData = True
Exit Function
ErrHandle:
MsgInfo = "错误:" & Err.Description
getCellData = False
End Function
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -