VBA 类

Option Explicit
Dim WithEvents stus As students
Private Sub CommandButton1_Click()
  Dim s$, stu As New Student
  s = InputBox("请输入姓名", "增加")
  stu.Name = s
  stus.Add stu
  RefreshLstv
End Sub
Private Sub CommandButton2_Click()
  Dim s$
  s = InputBox("请输入要删除的ID或序号", "删除")
  stus.Remove IIf(IsNumeric(s), CInt(Val(s)), s)
End Sub

Private Sub CommandButton3_Click()
  MsgBox "当前学员数为:" & stus.Count
End Sub

Private Sub CommandButton4_Click()
  Dim s$
  If stus.Count = 0 Then Exit Sub
  s = InputBox("请输入要查询的ID或序号", "查询")
  MsgBox "学员姓名为" & stus.Item(IIf(IsNumeric(s), CInt(Val(s)), s)).Name
End Sub
Private Sub stus_AfterRemove()
  RefreshLstv
End Sub
Private Sub stus_BeforeAdd(ByVal stu As Student, Cancel As Boolean)
  Dim i%
  For i = 1 To stus.Count
    If stus.Item(i).Name = stu.Name Then
      If MsgBox(stu.Name & "已存在,要增加吗?", vbYesNo) = vbNo Then
        Cancel = True
        Exit Sub
      End If
    End If
  Next i
End Sub
Private Sub UserForm_Initialize()
  With ListView1.ColumnHeaders
    .Add , , "Id", 40
    .Add , , "Name", 50
  End With
  Set stus = New students
End Sub
Private Sub RefreshLstv()
  Dim i%
  With ListView1.ListItems
    .Clear
    For i = 1 To stus.Count
      .Add(, , stus.Item(i).id).SubItems(1) = stus.Item(i).Name
    Next i
  End With
End Sub

 

student类：

Option Explicit
Private s$, i_d$
Property Let Name(ByVal nm As String)
  s = Trim(nm)
End Property
Property Get Name() As String
  Name = s
End Property
Property Let id(ByVal i As String)
  Static hi As Boolean
  If Not hi Then
    hi = True
    If UCase(Left(i, 1)) = "S" Then i = Mid(i, 2)
    i_d = "S" & Format(i, "00")
  Else
    MsgBox "不能改变id设置"
    End
  End If
End Property
Property Get id() As String
  id = i_d
End Property

 

students类

Option Explicit
Private cllc As New Collection
Public Event BeforeAdd(ByVal stu As Student, ByRef Cancel As Boolean)
Public Event AfterRemove()
Property Get Count() As Integer
  Count = cllc.Count
End Property
Sub Add(ByVal stu As Student)
  Dim cnc As Boolean
  Static i As Integer
  RaiseEvent BeforeAdd(stu, cnc)
  If cnc Then Exit Sub
  i = i + 1
  stu.id = i
  cllc.Add stu
End Sub
Sub Remove(ByVal i)
  Dim n As Integer
  If TypeName(i) = "Integer" Then
    cllc.Remove i
    RaiseEvent AfterRemove
    Exit Sub
  End If
  If TypeName(i) = "String" Then
    For n = 1 To cllc.Count
      If cllc.Item(n).id = UCase(i) Then
         cllc.Remove n
         RaiseEvent AfterRemove
         Exit Sub
      End If
    Next n
  End If
End Sub
Function Item(ByVal i) As Student
  Dim n As Integer
  If TypeName(i) = "Integer" Then
    Set Item = cllc.Item(i)
    Exit Function
  End If
  If TypeName(i) = "String" Then
    For n = 1 To cllc.Count
      If cllc.Item(n).id = UCase(i) Then
        Set Item = cllc.Item(n)
        Exit Function
      End If
    Next n
  End If
  Set Item = Nothing
End Function