VBA代码实例之交互录入页面

先上演示：

根据交互页面录入对应的信息

操作代码如下：

1、将下列代码复制到工作表--查看代码中

'在双击单元格的时候自动调用
Private Sub Worksheet_BeforeDoubleClick _
(ByVal Target As Range, Cancel As Boolean)
If Target.Column = 1 Then
交互输入 (Target.Row)
End If
End Sub

将代码复制到工作表事件中

2、复制下列代码，将复制的代码粘贴至模块代码中。（可以继续向下看动画操作演示）

'实现交互输入的主体过程
Sub 交互输入(rowNum As Integer)
Application.ScreenUpdating = False
Dim result As Boolean
Do
result = InputNum(rowNum) '学号
Loop Until (result = True)
Do
result = InputName(rowNum) '学生姓名
Loop Until (result = True)
Do
result = InputSex(rowNum) '性别
Loop Until (result = True)
Do
result = InputName1(rowNum) '家长姓名
Loop Until (result = True)
Do
result = InputPhone(rowNum) '家长联系方式
Loop Until (result = True)
Application.ScreenUpdating = True
End Sub
'输入学号的函数
Function InputNum(rowNum As Integer) As Boolean
Dim answer As String
answer = InputBox("请输入学号")
If answer = "" Then
InputNum = True
Exit Function
End If
answer = Trim(answer)
InputNum = False
On Error GoTo prompt
Dim digit As Long
digit = CLng(answer)
If Len(answer) = 3 Then
InputNum = True
End If
If InputNum = True Then
Worksheets(1).Cells(rowNum, 1) = answer
Else
prompt: MsgBox ("输入内容必须为3位数字，请重新输入")
End If
End Function
'输入姓名的函数
Function InputName(rowNum As Integer) As Boolean
Dim answer As String
answer = InputBox("请输入学生姓名")
If answer = "" Then
InputName = True
Exit Function
End If
answer = Trim(answer)
Worksheets(1).Cells(rowNum, 2) = answer
InputName = True
End Function
'输入性别的函数
Function InputSex(rowNum As Integer) As Boolean
Dim answer As String
answer = InputBox("请输入学生性别")
answer = Trim(answer)
InputSex = False
Dim sex(2) As String
sex(1) = "男"
sex(2) = "女"
For Each one In sex
If answer = one Then
InputSex = True
End If
Next one
If InputSex = True Then
Worksheets(1).Cells(rowNum, 3) = answer
Else
MsgBox ("只能输入男或女，请重新输入")
End If
End Function
'输入家长姓名的函数
Function InputName1(rowNum As Integer) As Boolean
Dim answer As String
answer = InputBox("请输入家长姓名")
If answer = "" Then
InputName1 = True
Exit Function
End If
answer = Trim(answer)
Worksheets(1).Cells(rowNum, 4) = answer
InputName1 = True
End Function
'输家长入联系方式的函数
Function InputPhone(rowNum As Integer) As Boolean
Dim answer As String
answer = InputBox("请输入家长的联系方式(11位)")
If answer = "" Then
InputPhone = True
Exit Function
End If
answer = Trim(answer)
InputPhone = False
On Error GoTo prompt
If Len(answer) = 11 Then
InputPhone = True
End If
If InputPhone = True Then
Worksheets(1).Cells(rowNum, 5) = answer
Else
prompt: MsgBox ("输入的内容必须为11位数字，请重新输入")
End If
End Function