在Excel中，我已經(jīng)創(chuàng)建了一個輸入數(shù)據(jù)的用戶窗體，用于在工作記錄工作表中添加新數(shù)據(jù)記錄。最近，老板提出了新的需求，要通過該用戶窗體能夠編輯數(shù)據(jù)記錄，增強其功能。
這是我們在使用Excel編程時經(jīng)常會遇到的問題。雖說直接在工作表中添加數(shù)據(jù)沒有什么不好的，但就是有很多人喜歡使用自已設計的界面輸入數(shù)據(jù)，包括我自已。在設計好輸入數(shù)據(jù)界面后，更進一步增強界面的功能，可以查找數(shù)據(jù)，對找到的數(shù)據(jù)進行編輯并將修改更新到工作表中。如下所示。
用戶窗體界面設計
存儲數(shù)據(jù)的工作表如下所示。
其中，用于導航的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 =25
‘ 全局變量聲明
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
‘與工作表行數(shù)相關的變量聲明
Public lngLastRow As Long
Public lngRow As Long
Public lngMatchRow As Long
‘獲取工作表中最后的數(shù)據(jù)行
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
用戶窗體模塊代碼
在用戶窗體模塊中，輸入下面的代碼：
‘清空用戶窗體中的數(shù)據(jù)
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
‘檢查所有的內(nèi)容是否都已填寫.
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& “優(yōu)先級 :” & vbCrLf
End If
‘如果有內(nèi)容沒有填寫
‘則用信息框給用戶顯示相關信息
If blnFormComplete = False Then
strMsg = “下列內(nèi)容還沒有填寫完成: ” & vbCrLf &strNotCompleted
lngStyle = vbOKOnly + vbInformation
strTitle = “不能添加記錄 – 未完成內(nèi)容填寫”
Beep
intResponse = MsgBox(strMsg,lngStyle, strTitle)
Exit Sub
End If
‘查找工作表中最后一行之后的空行
lngLastRow = LastRow(wsProjectData, 1)+ 1
‘將用戶窗體數(shù)據(jù)輸入到工作表
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”), )
On Error GoTo
‘已找到要編輯的項目編號
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
‘用找到的項目編號所在行數(shù)據(jù)填充用戶窗體
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 =
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”), )
On Error GoTo
‘找到了項目編號.
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
‘數(shù)據(jù)行的首行
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)
‘鼠標經(jīng)過控件時高亮顯示該控件
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
‘使顯示記錄條數(shù)信息的標簽不可見
Me.lblRecordNofTotal.Visible = False
‘清除用戶窗體中的數(shù)據(jù)
ClearUserForm
End Sub
‘查找和編輯模式
Private SuboptSearchAndEditMode_Click()
‘將按鈕文本修改為”編輯記錄”
Me.cmdAddEdit.Caption = “編輯記錄”
Me.cmdAddEdit.ControlTipText = “編輯記錄”
‘使查找項目編號按鈕可見
Me.cmdProjectNumberFind.Visible = True
‘使導航欄可見
Me.fraNavigate.Visible = True
‘使顯示記錄條數(shù)信息的標簽可見
Me.lblRecordNofTotal.Visible = True
‘顯示工作表中第2行的數(shù)據(jù)
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
在代碼中添加了一些注釋，供參考。
示例工作簿
代碼太長，但很簡潔明了，可以作為一個模板，稍作修改即可用于其它輸入、查找和編輯的情形。如果你有類似的需求或者想要進一步研究，可以下載示例工作簿。
