本文于2023年5月15日首发于本人同名公众号，更多文章案例请关注微信公众号：Excel活学活用！ ☆本期内容概要☆ 上期我们分享了【收费管理系统】主界面设计【Excel VBA 主界面/一步一步带你设计【收费管理系统】02】，本期我们将设计【用户管理】模块功能！ 今天的任务是设置【用户管理】模块功能，实现对用户的增、删、改。 下面我们就开始： 1、为了避免不小心删除所有用户，造成无法登录，我们增加一个admin用户，在用户管理界面不显示它，保证至少有一个用户可以登录，再增加一个字段“状态”，分为正常、封存，后续可以限制状态非正常的用户登录。 2、增加“tb用户权限”表，供增加、修改用户时选择使用。 3、在VBE中插入用户窗体，命名为Usf_AddAndModify（增加与修改，实际还有删除）。原来是想命名为Usf_Users，但出于某些原因考虑，采用目前的名称： （1）我们这里的设计模式是：打开窗体，将数据展示在ListView控件中，点选一条记录，可以设法进行修改。 （2）由于ListView不可以直接进行修改，我们可以采取以下方式： （a）添加文本框控件，将需要修改的记录数据读入文本框，修改后保存，同步更新到数据库。 （b）通过InkEdit控件，实现在ListView中“直接”修改数据的功能，这里“直接”加了引号，实际上是编辑InkEdit控件的值，再更新到ListView对应单元格。看上去好象是直接编辑ListView。这种方法需要使用API函数，代码相对复杂。 （3）经过慎重考虑，我还是决定采用第二种方法，因为我前面提及到的《财务管理系统》就是这样设计的，效果不错。 （4）关于“直接”编辑ListView，这种方法不是我发明的，不敢居功，我是参考了ExcelHome论坛一个贴子（[原创] VBA窗体Listview控件完全教程）这里对作者表示感谢！ （5）实际上，我是从我的《财务管理系统》中复制过来的，今天的工作主要是“删代码”，把不相干的代码删除，最后调试。 4、插入用户窗体，Usf_Interm，用于显示一些可供选择的内容，在双击Listview单元格（实际是InkEdit控件）时调用： 5、自定义函数： （1）ShiftKeyPressed，判断shift键是否被按下，这个前面分享过（Excel VBA 代码思路分享/如何通过点击命令按钮调整用户窗体及ListView的高度）： （2）RecordValue，取得查询结果值： （3）ExecuteSQL，执行SQL语句，用来执行更新、删除等操作： （4）IsArrEmpty，判断数组是否为空。 （5）Pxy，取得数组元素位置，主要用于查询表头字段位置。 （6）还有若干，这里不贴了，感兴趣的小伙伴可以索取示例文件。 6、Usf_AddandModify窗体代码，由于代码实在太多，这里也不贴了，我们放在第二条文章吧。我们来看一下使用过程： 功能及部分代码解析： （1）登录系统，我们增加了一个显示密码的选项： 代码解析：通过CheckBox控件的值的变化，改变PasswordChar的值。 （2）主界面用户管理按钮： 代码解析： line 2~10：这段代码目前用处不大，主要防止程序异常或者登录异常的情况下，用户信息丢失后，不宜再对数据库进行操作，需要重新正常登录。这里可以忽略，后续肯定要修改。 line 12~13：给CurrTable赋值，我们点击“用户管理”，目标就是“tb用户”表，后续操作都是针对这个表。这里通过改变CurrTabel的值，可以通过这一个窗体“Usf_AddandModify ”实现对多个表进行处理，这就是前文我为什么不给它命名为“Usf_Users”的原因。 其实，在我设计《财务管理系统》的时候，开始是采用一个功能模块一个窗体，最终造成了窗体过多，不得不进行一些合并，最终还是想出这样的办法，通过一个窗体来处理。主要关键点在于，读取、更新数据库的代码基本是相同的。 （3）管理用户表：对用户信息进行增加、删除、修改。这里设置了状态变量ModifyStatus，用来记录修改动作，有修改就+1；DeleteStatus，用来记录删除动作，有删除就+1；strModifiedID用来记录修改的ID，strDeletedId用来记录删除的ID，在保存的时候，根据这些ID记录来操作数据库。 （a）增加，可以通过新增、复制来增加一条记录：这里定义了一个过程AddNewItem，参数可以是“before”，“after”，“end”，可以在listview当前记录前、后以及结尾增加记录。 （b）删除，先把记录从listview列表中移去，记下ID，最后在保存的时候针对删除的ID给出确认提示。 （c）修改，有些字段可以修改，有些字段不能修改，这些信息在窗体启动时会进行一次设置： 代码解析：根据不同的表，指定相应的SQL语句、列宽、可编辑字段EditableField 、必需字段strRequiredField等。接着生成可编辑列号EditableCol 、必须列号strRequiredCol等。在有些表中，新增记录后可编辑列可能会发生变化，在新增、复制按钮代码里重新设置。 前文提及ExcelHome论坛帖子中，原作者把可编辑列、必填列直接指定数字“02/03/04”，这样在很多表需要操作的情况下，是非常难以指定的，而指定字段名称就方便多了，这也算是一点小改进吧。 （d）保存，在对listview进行一番操作以后，我们需要进行保存，更新数据库。 代码解析：根据strDeletedId来删除记录，根据strModifiedID来修改记录，如果listview的Text为空，即ID为空，则是新增记录。 （4）listview表头固定与调整。由于listview表头可以拖动，没有找到固定表头的方法，只好来个“曲线救国”，有个属性可以隐藏其表头，然后在一个frame里增加与listview表头数量相同的标签，对应显示表头字段的值，放在listview上方，看上去就像真的表头一样。在“解冻列宽”之后，显示真实表头，可以拖动改变宽度，点“适合列宽”，则会调整窗体宽度及部分按钮位置，点“固定列宽”则恢复到初始状态。 （5）可以关键字搜索记录，可以导出列表记录到EXCEL表，可选择文件夹。导出的功能前面分享过【Excel VBA 数据分析展示/ListView控件/数据导出/科目汇总表(5)】 剩下的就不多说了，各位可以参照示例文件自行研究。 今天的内容就这么多，后面会继续，敬请关注！还请大家多多点赞、留言、分享，谢谢大家，我们下期再会吧。 ☆猜你喜欢☆ Excel VBA 这样酷炫的日期控件，你不想要吗？ Excel 公式函数/数据透视表/固定资产折旧计提表！ Excel VBA 自定义函数/数组字段定位/数组字段排序 Excel 功能/公式函数/VBA/多种姿势处理重复值 Excel VBA 最简单的收发存登记系统 Excel 公式函数/查找函数之LOOKUP Excel VBA 文件批量改名 Excel 公式函数/数据验证/动态下拉列表 Excel VBA 输入逐步提示/TextBox+ListBox Excel 基础功能【数据验证】，你会怎么用？ 本文于2023年5月15日首发于本人同名公众号，更多文章案例请关注微信公众号：Excel活学活用！Private Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Function ShiftKeyPressed() As Boolean
ShiftKeyPressed = GetKeyState(vbKeyShift) < 0
End FunctionFunction RecordValue(dataFile As String, SQL As String)
'函数名的含义为“记录值”，实际为取到的第一行第一列的值
'通常用来 select count() 来取值，这样，函数的值或为0,或大于0,如果值为0,则表示没有记录
'可以用来判断一个表有没有记录，或者有没有指定字段符合一定条件的记录
On Error Resume Next
Dim cnn As Object '数据库连接
Dim rs As Object '临时数据表纪录
Dim StrCnn As String 'ACCESS连接语句
Dim aData()
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
passWord = "p111111"
StrCnn = GetStrCnn(dataFile, passWord)
cnn.Open StrCnn '打开数据库链接
Set rs = cnn.Execute(SQL) '执行查询，并将结果输出到记录集对象
aData = rs.getrows
RecordValue = aData(0, 0)
rs.Close
Set rs = Nothing
cnn.Close
Set cnn = Nothing
End FunctionSub ExecuteSQL(dataFile As String, SQL As String)
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
passWord = "p111111"
StrCnn = GetStrCnn(dataFile, passWord)
cnn.Open StrCnn '打开数据库链接
cnn.Execute (SQL)
cnn.Close
Set cnn = Nothing
End SubFunction IsArrEmpty(ByVal sArray As Variant) As Boolean '判断数组是否为空
IsArrEmpty = False
On Error GoTo ErrHandler:
i = UBound(sArray)
Exit Function
ErrHandler:
IsArrEmpty = True
End FunctionFunction Pxy(arr(), Field As String)
Pxy = Application.WorksheetFunction.Match(Field, arr, 0)
End FunctionPrivate Sub CkbShowPassword_Change()
If Me.CkbShowPassword.Value = True Then
Me.TxtPassWord.PasswordChar = ""
Else
Me.TxtPassWord.PasswordChar = "*"
End If
End SubPrivate Sub CmdUsers_Click()
Sheets("Settings").Activate
With ActiveSheet
iRow = .UsedRange.Rows.Count
currUserName = .Cells(Application.WorksheetFunction.Match("currUserName", .Range(Cells(1, 2), Cells(iRow, 2)), 0), 3)
End With
If currUserName = "" Then
MsgBox "当前登录用户信息丢失，请重新登录！"
Exit Sub
End If
Unload Me
currTable = "tb用户"
Usf_AddAndModify.Show
End Sub 'SQL语句,列宽 ，指定可编辑列，必填列的字段名称,标题
If currTable = "tb用户" Then
' Stop
initSQL = "select * from " & currTable & " where 用户ID<>'admin' and 用户ID<>'Superuser'"
arrWidth = Array(40, 100, 100, 80, 80, 80, 80, 80, 80, 80, 80, 60, 60, 60, 60, 60)
Me.LbTitle = "用户管理"
EditableField = "Except/用户ID"
strRequiredField = "All"
Else
initSQL = "select * from " & currTable
arrWidth = Array(40, 100, 100, 80, 80, 80, 80, 80, 80, 80, 80, 60, 60, 60, 60, 60)
Me.LbTitle = Right(currTable, Len(currTable) - 2)
EditableField = "All"
strRequiredField = "All"
End If
......
'根据指定字段转化可编辑列、必填列
With Me.LvDetail
For i = 1 To .ColumnHeaders.Count
If InStr(EditableField, "All") Then
If .ColumnHeaders(i) <> "ID" Then
EditableCol = EditableCol & Format(i, "00") & "/"
End If
ElseIf InStr(EditableField, "Except") Then
If .ColumnHeaders(i) <> "ID" And InStr(EditableField, .ColumnHeaders(i)) = 0 Then
EditableCol = EditableCol & Format(i, "00") & "/"
End If
Else
If InStr(EditableField, .ColumnHeaders(i)) Then
EditableCol = EditableCol & Format(i, "00") & "/"
End If
End If
If InStr(strRequiredField, "All") Then '如果是所有列都必填，第一列ID也是不需要且不能编辑的
If .ColumnHeaders(i) <> "ID" Then
strRequiredCol = strRequiredCol & Format(i, "00") & "/"
End If
ElseIf InStr(strRequiredField, "Except") Then
If .ColumnHeaders(i) <> "ID" And InStr(strRequiredField, .ColumnHeaders(i)) = 0 Then
strRequiredCol = strRequiredCol & Format(i, "00") & "/"
End If
Else
If InStr(strRequiredField, .ColumnHeaders(i)) Then
strRequiredCol = strRequiredCol & Format(i, "00") & "/"
End If
End If
Next
End With '删除记录
If Len(Replace(strDeletedId, "/", "")) > 0 Then
'Stop
strDeletedId = Left(strDeletedId, Len(strDeletedId) - 1)
arrID = Split(strDeletedId, "/")
If Not wContinue("即将删除以下ID的记录：" & Chr(10) & strDeletedId & Chr(10) & "此操作不可恢复，请谨慎执行！") Then Exit Sub
SQL = "delete * from " & currTable & " where id in (" & Join(arrID, ",") & ")"
Call ExecuteSQL(dataFile, SQL)
End If
'增加、修改记录，建立数据连接
Set cnn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
passWord = "p111111"
StrCnn = GetStrCnn(dataFile, passWord)
cnn.Open StrCnn
rs.Open currTable, cnn, 1, 3
With Me.LvDetail
For i = 1 To .ListItems.Count
If Len(Trim(.ListItems(i).Text)) > 0 Then '对id不为空的记录，即可能被修改的记录进行操作
If InStr(strModifiedID, .ListItems(i).Text) Then '判断存放id的数组是否为空值，如果为空，则表明没有修改的记录，不用执行更新
rs.movefirst
Do Until rs.EOF
If rs!ID = .ListItems(i).Text Then
'rs.Edit
For k = 1 To .ColumnHeaders.Count - 1
'数据库中“是/否”字段值为“-1/0”，但显示为“true/false”
rs.Fields(k) = IIf(.ListItems(i).SubItems(k) = "true", -1, IIf(.ListItems(i).SubItems(k) = "false", 0, .ListItems(i).SubItems(k)))
Next
rs.Update
End If
rs.MoveNext
Loop
End If
Else '对id为空的记录，即新增的记录进行操作，向数据库写入记录
rs.AddNew
For k = 1 To .ColumnHeaders.Count - 1
rs.Fields(k) = IIf(.ListItems(i).SubItems(k) = "true", -1, IIf(.ListItems(i).SubItems(k) = "false", 0, .ListItems(i).SubItems(k)))
Next
rs.Update
End If
Next
End With
rs.Close
cnn.Close
Set rs = Nothing
Set cnn = Nothing