专栏首页完美ExcelExcel应用实践12:在用户窗体中添加、查找和编辑数据记录

Excel应用实践12:在用户窗体中添加、查找和编辑数据记录

学习Excel技术,关注微信公众号:

excelperfect

在Excel中,我已经创建了一个输入数据的用户窗体,用于在工作记录工作表中添加新数据记录。最近,老板提出了新的需求,要通过该用户窗体能够编辑数据记录,增强其功能。

这是我们在使用Excel编程时经常会遇到的问题。虽说直接在工作表中添加数据没有什么不好的,但就是有很多人喜欢使用自已设计的界面输入数据,包括我自已。在设计好输入数据界面后,更进一步增强界面的功能,可以查找数据,对找到的数据进行编辑并将修改更新到工作表中。如下图1所示。

图1

用户窗体界面设计

存储数据的工作表如下图2所示。

图2

根据工作表数据结构,设计用户窗体如下图3所示。

图3

其中,用于导航的4个标签按钮放置在一个名为fraNavigate的框架控件中。

编写代码

通用代码

在标准模块中,输入下面的代码:

' API声明

#If VBA7 And Win64 Then

Public Declare PtrSafe Sub Sleep Lib"kernel32" (ByVal dwMilliseconds As LongPtr)

#Else

Public Declare Sub Sleep Lib"kernel32" (ByVal dwMilliseconds As Long)

#End If

' 常量声明

Public Const MOUSE_DOWN_SLEEP =250

' 全局变量声明

Public blnFormComplete AsBoolean

Public blnMouseDown As Boolean

Public strNotCompleted AsString

' 代表消息框信息的变量声明

Public intResponse As Integer

Public lngStyle As Long

Public strInput As String

Public strMsg As String

Public strTitle As String

'与工作表行数相关的变量声明

Public lngLastRow As Long

Public lngRow As Long

Public lngMatchRow As Long

'获取工作表中最后的数据行

Public Function LastRow( _

objWorkSheetFindLastRow As Worksheet, _

intColFindLastRow As Integer) As Long

With objWorkSheetFindLastRow

LastRow = .Cells(.Rows.Count, _

intColFindLastRow).End(xlUp).Row

End With

End Function

用户窗体模块代码

在用户窗体模块中,输入下面的代码:

'清空用户窗体中的数据

Private Sub ClearUserForm()

Me.txtProjectNumber = ""

Me.txtProjectName = ""

Me.cboAnalyst = ""

Me.cboClient = ""

Me.txtDueDate = ""

Me.txtPriority = ""

Me.cboNumberSamples = ""

End Sub

'添加记录

Private Sub cmdAddEdit_Click()

'添加记录

If Me.cmdAddEdit.Caption = "添加记录" Then

'检查所有的内容是否都已填写.

blnFormComplete = True

strNotCompleted = ""

If Me.txtProjectNumber = ""Then

blnFormComplete = False

strNotCompleted = "项目编号 :" & vbCrLf

End If

If Me.txtProjectName = ""Then

blnFormComplete = False

strNotCompleted = strNotCompleted& "项目名称 :" & vbCrLf

End If

If Me.cboAnalyst = "" Then

blnFormComplete = False

strNotCompleted = strNotCompleted& "分析人 :" & vbCrLf

End If

If Me.cboClient = "" Then

blnFormComplete = False

strNotCompleted = strNotCompleted& "客户 :" & vbCrLf

End If

If Me.txtDueDate = "" Then

blnFormComplete = False

strNotCompleted = strNotCompleted& "截止日期 :" & vbCrLf

End If

If Me.txtPriority = "" Then

blnFormComplete = False

strNotCompleted = strNotCompleted& "优先级 :" & vbCrLf

End If

'如果有内容没有填写

'则用信息框给用户显示相关信息

If blnFormComplete = False Then

strMsg = "下列内容还没有填写完成: " & vbCrLf &strNotCompleted

lngStyle = vbOKOnly + vbInformation

strTitle = "不能添加记录 - 未完成内容填写"

Beep

intResponse = MsgBox(strMsg,lngStyle, strTitle)

Exit Sub

End If

'查找工作表中最后一行之后的空行

lngLastRow = LastRow(wsProjectData, 1)+ 1

'将用户窗体数据输入到工作表

wsProjectData.Cells(lngLastRow,"A") = Me.txtProjectNumber

wsProjectData.Cells(lngLastRow,"B") = Me.txtProjectName

wsProjectData.Cells(lngLastRow,"C") = Me.cboAnalyst

wsProjectData.Cells(lngLastRow,"D") = Me.cboClient

wsProjectData.Cells(lngLastRow,"E") = Me.txtDueDate

wsProjectData.Cells(lngLastRow,"F") = Me.txtPriority

wsProjectData.Cells(lngLastRow,"G") = Me.cboNumberSamples

'用信息框给用户显示相关信息

strMsg = "已添加记录到" & wsProjectData.Name& " 行" & Str(lngLastRow)

lngStyle = vbOKOnly + vbInformation

strTitle = "记录已添加"

Beep

intResponse = MsgBox(strMsg, lngStyle,strTitle)

'编辑记录

Else

strMsg = "编辑项目编号 : " & Me.txtProjectNumber& " ?"

lngStyle = vbYesNo + vbQuestion

strTitle = "编号记录 ?"

Beep

intResponse = MsgBox(strMsg, lngStyle,strTitle)

If intResponse = vbNo Then Exit Sub

On Error GoTo ProjectNumberNoMatch

'查找到要编辑的项目编号所在单元格

lngMatchRow =Application.Match(Me.txtProjectNumber, wsProjectData.Columns("A"), 0)

On Error GoTo 0

'已找到要编辑的项目编号

Me.lblRecordNofTotal = "在 " & Str(lngLastRow) &" 行中的第" & Str(lngMatchRow) & " 行"

'更新记录

wsProjectData.Cells(lngMatchRow,"A") = Me.txtProjectNumber

wsProjectData.Cells(lngMatchRow,"B") = Me.txtProjectName

wsProjectData.Cells(lngMatchRow,"C") = Me.cboAnalyst

wsProjectData.Cells(lngMatchRow,"D") = Me.cboClient

wsProjectData.Cells(lngMatchRow,"E") = Me.txtDueDate

wsProjectData.Cells(lngMatchRow,"F") = Me.txtPriority

wsProjectData.Cells(lngMatchRow,"G") = Me.cboNumberSamples

'用找到的项目编号所在行数据填充用户窗体

PopulateUserForm lngMatchRow

'用信息框显示相应信息

strMsg = "项目编号 : " & Me.txtProjectNumber & " 已更新."

lngStyle = vbOKOnly + vbInformation

strTitle = "记录已更新"

Beep

intResponse = MsgBox(strMsg, lngStyle,strTitle)

End If

Exit Sub

ProjectNumberNoMatch:

strMsg = "项目编号 " & Me.txtProjectNumber& " 没有找到."

lngStyle = vbOKOnly + vbInformation

strTitle = "没有找到项目编号"

Beep

intResponse = MsgBox(strMsg, lngStyle,strTitle)

End Sub

Private SubcmdProjectNumberFind_Click()

lngMatchRow = 0

If Me.txtProjectNumber = "" Then

strMsg = "没有指要查找的项目编号."

lngStyle = vbOKOnly + vbInformation

strTitle = "没有指定项目编号"

Beep

intResponse = MsgBox(strMsg, lngStyle,strTitle)

Exit Sub

End If

On Error GoTo ProjectNumberNoMatch

lngMatchRow =Application.Match(Me.txtProjectNumber, wsProjectData.Columns("A"), 0)

On Error GoTo 0

'找到了项目编号.

Me.lblRecordNofTotal = "在 " & Str(lngLastRow) &" 行中的第" & Str(lngMatchRow) & " 行"

lngRow = lngMatchRow

PopulateUserForm lngMatchRow

Exit Sub

ProjectNumberNoMatch:

strMsg = "项目编号 " & Me.txtProjectNumber& " 没有找到."

lngStyle = vbOKOnly + vbInformation

strTitle = "没有找到项目编号"

Beep

intResponse = MsgBox(strMsg, lngStyle,strTitle)

End Sub

'---------------------------

'设置导航按钮

'---------------------------

Private Sub lblFirst_Click()

lngRow = 2

PopulateUserForm lngRow

Me.lblRecordNofTotal = "在 " & Str(lngLastRow) &" 行中的第2行"

End Sub

Private Sub lblFirst_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

Me.lblFirst.SpecialEffect =fmSpecialEffectSunken

End Sub

Private Sub lblFirst_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

RestoreBackColors

MouseMove "lblFirst"

End Sub

Private Sub lblFirst_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

Me.lblFirst.SpecialEffect =fmSpecialEffectRaised

End Sub

Private Sub lblLast_Click()

lngRow = lngLastRow

PopulateUserForm lngRow

Me.lblRecordNofTotal = "在 " & Str(lngLastRow) &" 行中的最后一行"

End Sub

Private Sub lblLast_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

Me.lblLast.SpecialEffect =fmSpecialEffectSunken

End Sub

Private Sub lblLast_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

RestoreBackColors

MouseMove "lblLast"

End Sub

Private Sub lblLast_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

Me.lblLast.SpecialEffect =fmSpecialEffectRaised

End Sub

Private Sub lblNext_MouseDown(ByValButton As Integer, ByVal Shift As Integer, ByVal X As Single, ByVal Y AsSingle)

Me.lblNext.SpecialEffect =fmSpecialEffectSunken

MouseDownNext

End Sub

Private Sub lblNext_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

RestoreBackColors

MouseMove "lblNext"

End Sub

Private Sub lblNext_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

Me.lblNext.SpecialEffect =fmSpecialEffectRaised

blnMouseDown = False

End Sub

Private Sub lblPrev_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

Me.lblPrev.SpecialEffect =fmSpecialEffectSunken

MouseDownPrevious

End Sub

Private Sub lblPrev_MouseMove(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

RestoreBackColors

MouseMove "lblPrev"

End Sub

Private Sub lblPrev_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal X AsSingle, ByVal Y As Single)

Me.lblPrev.SpecialEffect =fmSpecialEffectRaised

blnMouseDown = False

End Sub

Private Sub MouseDownNext()

blnMouseDown = True

Do While blnMouseDown = True

Select Case lngRow

Case lngLastRow

lngRow = lngLastRow

Case Else

lngRow = lngRow + 1

'到达最后一行

If lngRow >= lngLastRow ThenlngRow = lngLastRow

PopulateUserForm lngRow

End Select

Me.lblRecordNofTotal = "在 " & Str(lngLastRow) &" 行中的第 " & Trim(Str(lngRow)) & " 行"

Sleep MOUSE_DOWN_SLEEP

DoEvents

Loop

End Sub

Private Sub MouseDownPrevious()

blnMouseDown = True

Do While blnMouseDown = True

Select Case lngRow

Case 2

'数据行的首行

lngRow = 2

Case Else

lngRow = lngRow - 1

'到达首行

If lngRow <= 2 Then lngRow = 2

PopulateUserForm lngRow

End Select

Me.lblRecordNofTotal = "在 " & Str(lngLastRow) &" 行中的第 " & Trim(Str(lngRow)) & " 行"

Sleep MOUSE_DOWN_SLEEP

DoEvents

Loop

End Sub

Sub MouseMove(strControl AsString)

'鼠标经过控件时高亮显示该控件

Select Case strControl

'标签名导航

Case "lblFirst"

Me.lblFirst.BackColor = vbYellow

Case "lblLast"

Me.lblLast.BackColor = vbYellow

Case "lblNext"

Me.lblNext.BackColor = vbYellow

Case "lblPrev"

Me.lblPrev.BackColor = vbYellow

End Select

End Sub

'添加模式

Private Sub optAddMode_Click()

'将按钮文本修改为"添加记录"

Me.cmdAddEdit.Caption = "添加记录"

Me.cmdAddEdit.ControlTipText = "添加记录"

'使查找项目编号按钮不可见

Me.cmdProjectNumberFind.Visible = False

'使导航栏不可见

Me.fraNavigate.Visible = False

'使显示记录条数信息的标签不可见

Me.lblRecordNofTotal.Visible = False

'清除用户窗体中的数据

ClearUserForm

End Sub

'查找和编辑模式

Private SuboptSearchAndEditMode_Click()

'将按钮文本修改为"编辑记录"

Me.cmdAddEdit.Caption = "编辑记录"

Me.cmdAddEdit.ControlTipText = "编辑记录"

'使查找项目编号按钮可见

Me.cmdProjectNumberFind.Visible = True

'使导航栏可见

Me.fraNavigate.Visible = True

'使显示记录条数信息的标签可见

Me.lblRecordNofTotal.Visible = True

'显示工作表中第2行的数据

lngRow = 2

lngLastRow = LastRow(wsProjectData, 1)

PopulateUserForm 2

Me.lblRecordNofTotal = "在 " & Str(lngLastRow) &" 行中的第 " & Trim(Str(lngRow)) & " 行"

End Sub

'重置按钮标签颜色

Private Sub RestoreBackColors()

Me.lblFirst.BackColor = vbWhite

Me.lblNext.BackColor = vbWhite

Me.lblPrev.BackColor = vbWhite

Me.lblLast.BackColor = vbWhite

End Sub

'激活用户窗体时

Private Sub UserForm_Activate()

'填充组合框

With Me.cboAnalyst

.AddItem "Analyst 1"

.AddItem "Analyst 2"

.AddItem "Analyst 3"

.AddItem "Analyst 4"

End With

With Me.cboClient

.AddItem "Client 1"

.AddItem "Client 2"

.AddItem "Client 3"

.AddItem "Client 4"

End With

With Me.cboNumberSamples

.AddItem "Number Samples 1"

.AddItem "Number Samples 2"

.AddItem "Number Samples 3"

.AddItem "Number Samples 4"

End With

End Sub

'填充用户窗体中的控件

Public Sub PopulateUserForm(lngPopulateRow As Long)

Me.txtProjectNumber =wsProjectData.Cells(lngPopulateRow, "A")

Me.txtProjectName =wsProjectData.Cells(lngPopulateRow, "B")

Me.cboAnalyst =wsProjectData.Cells(lngPopulateRow, "C")

Me.cboClient =wsProjectData.Cells(lngPopulateRow, "D")

Me.txtDueDate =wsProjectData.Cells(lngPopulateRow, "E")

Me.txtPriority =wsProjectData.Cells(lngPopulateRow, "F")

Me.cboNumberSamples =wsProjectData.Cells(lngPopulateRow, "G")

End Sub

在代码中添加了一些注释,供参考。

示例工作簿

代码太长,但很简洁明了,可以作为一个模板,稍作修改即可用于其它输入、查找和编辑的情形。如果你有类似的需求或者想要进一步研究,可以下载示例工作簿。

在完美Excel微信公众号底部发送消息:

交互式用户窗体

即可获取下载链接。

本文分享自微信公众号 - 完美Excel(excelperfect),作者:fanjy

原文出处及转载信息见文内详细说明,如有侵权,请联系 yunjia_community@tencent.com 删除。

原始发表时间:2019-05-23

本文参与腾讯云自媒体分享计划,欢迎正在阅读的你也加入,一起分享。

我来说两句

0 条评论
登录 后参与评论

相关文章

  • Excel实战技巧71: 自动响应消息框信息

    运行test过程,将打开C盘中名为test.xlsm的工作簿,并弹出如下图1所示的消息框。

    fanjy
  • VBA实用小程序50: 在指定的单元格中插入指定的形状

    下面的自定义函数使用Shapes集合对象的AddShape方法及其参数,可以在指定的单元格中插入指定的形状。

    fanjy
  • 一起学Excel专业开发26:使用类模块创建对象5

    类模块具有引发事件的能力,这也是它的另一个强大的功能。我们可以定义自已的事件,并在代码中引发这个事件,其他类模块也可以捕获这些自定义的事件并作出相应的响应。

    fanjy
  • VB.NET 程序通过嵌入福昕PDF阅读器控件显示PDF

    备注:以上两种方法都可以打开别人共享文件夹(或者服务器)中的PDF文件;只要引用共享(或者服务器)地址即可! 比如共享地址为:"\\192.168.0.1\pd...

    巴西_prince
  • VB.NET 日常开销记账本示例

    '-------------------------------------------------------------------------------

    巴西_prince
  • VB.NET 脚本计算机示例

    巴西_prince
  • 打分排序系统漫谈1 - 时间衰减

    打分排序系统的应用非常普遍,比如电影的评分,知乎帖子的热度,和新闻文章的排序。让我们从最简单直观的平均打分开始, 聊聊各种打分方法的利弊和使用场景。

    风雨中的小七
  • Netty 之传统 BIO、NIO 编程

    系列文章:http://www.jianshu.com/p/594441fb9c9e

    Yano_nankai
  • Java并非锁之独占非公平锁理解

    在Java并发编程中,锁是一个很重要的对象。Java中锁有两种:隐式锁和显式锁。使用synchronized关键字的锁是隐式锁。因为锁的申请和释放都是由JVM来...

    凯哥Java
  • [推荐系统读书笔记]好的推荐系统

    在这个时代,无论是信息消费者还是信息生产者都遇到了很大的挑战:作为信息消费者,如何从大量信息中找到自己感兴趣的信息是一件非常困难的事情;作为信息生产者,如何让自...

    用户1631856

扫码关注云+社区

领取腾讯云代金券