12.1 持久存储需求
12.2 类的部分描述
12.3 规划系统
12.4 安全问题
12.5 Setting类
代码清单 12.1：完整的setting类
代码
'代码清单 12.1：完整的setting类
'private class variables
Private mwsSettings As Worksheet
Private mrgSetting As Range
Private mbAllowEditing As Boolean
'private class constants
Private Const SETTING_WORKSHEET = "Settings"
Private Const VALUE_OFFSET = 1
Private Const TYPE_OFFSET = 2
Private Const DESCRIPTION_OFFSET = 3
Private Const CHANGE_EVENT_OFFSET = 4
'Enumeration for the kinds of setting types
Enum SetSettingType
setPrivate = 0
setReadOnly = 1
setReadWrite = 2
setReadProtectedWrite = 3 'read-write with password
End Enum
'setting description
Public Property Get Description() As String
If mrgSetting Is Nothing Then
Description = ""
Else
Description = mrgSetting.Offset(0, DESCRIPTION_OFFSET).Value
End If
End Property
Public Property Let Description(ByVal PropertyDescription As String)
If mrgSetting Is Nothing Then
UninitializedError
Else
'mbAllowEditing is managed by the EditMode method.
If mbAllowEditing Then
mrgSetting.Offset(0, DESCRIPTION_OFFSET).Value = PropertyDescription
Else
ReadOnlyError
End If
End If
End Property
'setting EventHandler - represents a procedure that
'gets called automatically when the setting's value changes
Public Property Get EventHandler() As String
If mrgSetting Is Nothing Then
EventHandler = ""
Else
'mbAllowEditing is managed by the EditMode method.
EventHandler = mrgSetting.Offset(0, CHANGE_EVENT_OFFSET).Value
End If
End Property
Public Property Let EventHandler(ByVal EventHandlerProcedure As String)
If mrgSetting Is Nothing Then
UninitializedError
Else
'mbAllowEditing is managed by the EditMode method.
If mbAllowEditing Then
mrgSetting.Offset(0, CHANGE_EVENT_OFFSET).Value = EventHandlerProcedure
Else
ReadOnlyError
End If
End If
End Property
'the settings are ordered by row on the settings worksheet.
'because this worksheet includes one row for column headings,
'you can get the index of the setting by looking at
'the row of the setting and subtracting one.
Public Property Get Index() As Long
If mrgSetting Is Nothing Then
Index = -1
Else
Index = mrgSetting.Row - 1
End If
End Property
Public Property Get Name() As String
If mrgSetting Is Nothing Then
Name = ""
Else
Name = mrgSetting.Value
End If
End Property
Public Property Let Name(ByVal PropertyName As String)
'name is implemented as a read-only property
'so you can create dependencies on setting names in your code.
End Property
Public Property Get SettingType() As SetSettingType
If mrgSetting Is Nothing Then
SettingType = -1
Else
SettingType = mrgSetting.Offset(0, TYPE_OFFSET)
End If
End Property
Public Property Let SettingType(ByVal SettingType As SetSettingType)
If mrgSetting Is Nothing Then
UninitializedError
Else
If mbAllowEditing Then
mrgSetting.Offset(0, TYPE_OFFSET).Value = SettingType
Else
ReadOnlyError
End If
End If
End Property
Public Property Get Value() As Variant
If mrgSetting Is Nothing Then
Value = ""
Else
Value = mrgSetting.Offset(0, VALUE_OFFSET)
End If
End Property
Public Property Let Value(ByVal PropertyValue As Variant)
If mrgSetting Is Nothing Then
UninitializedError
Else
If mbAllowEditing Then
'ok - change the value
mrgSetting.Offset(0, VALUE_OFFSET).Value = PropertyValue
'call any procedures sepified by the setting
'in the event of a change
ExecuteEventHandler
Else
ReadOnlyError
End If
End If
End Property
Public Function Delete() As Boolean
Delete = False
If mrgSetting Is Nothing Then
UninitializedError
Else
If mbAllowEditing Then
mrgSetting.EntireRow.Delete (xlUp)
Set mrgSetting = Nothing
Delete = True
Else
ReadOnlyError
End If
End If
End Function
Public Function ChangeEditMode(AllowEditing As Boolean, Optional password As Variant) As Boolean
If AllowEditing Then
Select Case Me.SettingType
Case SetSettingType.setPrivate
'private setings are settings used for programatic purposes or
'otherwise that should not be displayed on any user interface but
'can be freely modified programmatically
mbAllowEditing = True
Case SetSettingType.setReadOnly
'settings that are not intended to be changed by users but are useful to know.
'Never allow EditMode on these.
mbAllowEditing = False
Case SetSettingType.setReadWrite
'settings that can be freely modified by the user
mbAllowEditing = True
Case SetSettingType.setReadProtectedWrite
'settings that can be read but only changed by users that know the password
'IsMissing是测试可选参数是否传递给过程的函数，isMissing参数的类型只能是Variant类型
If IsMissing(password) Then
mbAllowEditing = False
Else
If ValidPassword(CStr(password)) Then
mbAllowEditing = True
Else
mbAllowEditing = False
End If
End If
Case Else
'unknow setting type
mbAllowEditing = False
End Select
Else
mbAllowEditing = False
End If
ChangeEditMode = mbAllowEditing
End Function
Public Function GetSetting(SettingName As String) As Boolean
Dim lRow As Integer
Dim bFoundSetting As Boolean
Set mrgSetting = Nothing
bFoundSetting = False
mbAllowEditing = False
lRow = 2
Do Until IsEmpty(mwsSettings.Cells(lRow, 1))
If UCase(mwsSettings.Cells(lRow, 1).Value) = UCase(SettingName) Then
Set mrgSetting = mwsSettings.Cells(lRow, 1)
bFoundSetting = True
Exit Do
End If
lRow = lRow + 1
Loop
GetSetting = bFoundSetting
End Function
Private Sub UninitializedError()
Err.Raise vbObjectError + 101, "Setting Class", _
"The setting has not been properly initialized. Use the GetSetting method to initialize the setting."
End Sub
Private Sub ReadOnlyError()
Err.Raise vbObjectError + 102, "Setting Class", _
"The setting you are trying to change is " & _
"either read-only, requires a password, or you have not put the object in edit mode. " & _
"Using the EditMode method ."
End Sub
Private Sub Class_Initialize()
'don't allow editing by default
mbAllowEditing = False
'need to point the mwsWorksheet variable to the settings worksheet
'WorksheetExists，见代码清单7.2
If WorksheetExists(ThisWorkbook, SETTING_WORKSHEET) Then
Set mwsSettings = ThisWorkbook.Worksheets(SETTING_WORKSHEET)
Else
Set mwsSettings = Nothing
Err.Raise vbObjectError + 100, "Setting Class", _
"the worksheet named " & SETTING_WORKSHEET & " could not be located."
End If
End Sub
'validate password by comparing it against the value given by the password setting on the settings worksheet.
'Obviously, this assumes that the worksheet is managed such that it cann't be easily retrieved / discovered.
'WARNING: this provides only very basic security and should not be used to protect sensitive data.
Private Function ValidPassword(sPassword As String) As Boolean
Dim oSetting As Setting
Dim bValid As Boolean
bValid = False
Set oSetting = New Setting
If oSetting.GetSetting("Password") Then
If oSetting.Value = sPassword Then
bValid = True
Else
bValid = False
End If
Else
bValid = False
End If
Set oSetting = Nothing
ValidPassword = bValid
End Function
Private Sub ExecuteEventHandler()
On Error Resume Next
'make sure there is an event handler for the setting
If Len(Me.EventHandler) <> 0 Then
'call the procedure specified by the eventhandler property
'Application.Run "要运行的过程名字"
Application.Run Me.EventHandler
End If
End Sub
'private class variables
Private mwsSettings As Worksheet
Private mrgSetting As Range
Private mbAllowEditing As Boolean
'private class constants
Private Const SETTING_WORKSHEET = "Settings"
Private Const VALUE_OFFSET = 1
Private Const TYPE_OFFSET = 2
Private Const DESCRIPTION_OFFSET = 3
Private Const CHANGE_EVENT_OFFSET = 4
'Enumeration for the kinds of setting types
Enum SetSettingType
setPrivate = 0
setReadOnly = 1
setReadWrite = 2
setReadProtectedWrite = 3 'read-write with password
End Enum
'setting description
Public Property Get Description() As String
If mrgSetting Is Nothing Then
Description = ""
Else
Description = mrgSetting.Offset(0, DESCRIPTION_OFFSET).Value
End If
End Property
Public Property Let Description(ByVal PropertyDescription As String)
If mrgSetting Is Nothing Then
UninitializedError
Else
'mbAllowEditing is managed by the EditMode method.
If mbAllowEditing Then
mrgSetting.Offset(0, DESCRIPTION_OFFSET).Value = PropertyDescription
Else
ReadOnlyError
End If
End If
End Property
'setting EventHandler - represents a procedure that
'gets called automatically when the setting's value changes
Public Property Get EventHandler() As String
If mrgSetting Is Nothing Then
EventHandler = ""
Else
'mbAllowEditing is managed by the EditMode method.
EventHandler = mrgSetting.Offset(0, CHANGE_EVENT_OFFSET).Value
End If
End Property
Public Property Let EventHandler(ByVal EventHandlerProcedure As String)
If mrgSetting Is Nothing Then
UninitializedError
Else
'mbAllowEditing is managed by the EditMode method.
If mbAllowEditing Then
mrgSetting.Offset(0, CHANGE_EVENT_OFFSET).Value = EventHandlerProcedure
Else
ReadOnlyError
End If
End If
End Property
'the settings are ordered by row on the settings worksheet.
'because this worksheet includes one row for column headings,
'you can get the index of the setting by looking at
'the row of the setting and subtracting one.
Public Property Get Index() As Long
If mrgSetting Is Nothing Then
Index = -1
Else
Index = mrgSetting.Row - 1
End If
End Property
Public Property Get Name() As String
If mrgSetting Is Nothing Then
Name = ""
Else
Name = mrgSetting.Value
End If
End Property
Public Property Let Name(ByVal PropertyName As String)
'name is implemented as a read-only property
'so you can create dependencies on setting names in your code.
End Property
Public Property Get SettingType() As SetSettingType
If mrgSetting Is Nothing Then
SettingType = -1
Else
SettingType = mrgSetting.Offset(0, TYPE_OFFSET)
End If
End Property
Public Property Let SettingType(ByVal SettingType As SetSettingType)
If mrgSetting Is Nothing Then
UninitializedError
Else
If mbAllowEditing Then
mrgSetting.Offset(0, TYPE_OFFSET).Value = SettingType
Else
ReadOnlyError
End If
End If
End Property
Public Property Get Value() As Variant
If mrgSetting Is Nothing Then
Value = ""
Else
Value = mrgSetting.Offset(0, VALUE_OFFSET)
End If
End Property
Public Property Let Value(ByVal PropertyValue As Variant)
If mrgSetting Is Nothing Then
UninitializedError
Else
If mbAllowEditing Then
'ok - change the value
mrgSetting.Offset(0, VALUE_OFFSET).Value = PropertyValue
'call any procedures sepified by the setting
'in the event of a change
ExecuteEventHandler
Else
ReadOnlyError
End If
End If
End Property
Public Function Delete() As Boolean
Delete = False
If mrgSetting Is Nothing Then
UninitializedError
Else
If mbAllowEditing Then
mrgSetting.EntireRow.Delete (xlUp)
Set mrgSetting = Nothing
Delete = True
Else
ReadOnlyError
End If
End If
End Function
Public Function ChangeEditMode(AllowEditing As Boolean, Optional password As Variant) As Boolean
If AllowEditing Then
Select Case Me.SettingType
Case SetSettingType.setPrivate
'private setings are settings used for programatic purposes or
'otherwise that should not be displayed on any user interface but
'can be freely modified programmatically
mbAllowEditing = True
Case SetSettingType.setReadOnly
'settings that are not intended to be changed by users but are useful to know.
'Never allow EditMode on these.
mbAllowEditing = False
Case SetSettingType.setReadWrite
'settings that can be freely modified by the user
mbAllowEditing = True
Case SetSettingType.setReadProtectedWrite
'settings that can be read but only changed by users that know the password
'IsMissing是测试可选参数是否传递给过程的函数，isMissing参数的类型只能是Variant类型
If IsMissing(password) Then
mbAllowEditing = False
Else
If ValidPassword(CStr(password)) Then
mbAllowEditing = True
Else
mbAllowEditing = False
End If
End If
Case Else
'unknow setting type
mbAllowEditing = False
End Select
Else
mbAllowEditing = False
End If
ChangeEditMode = mbAllowEditing
End Function
Public Function GetSetting(SettingName As String) As Boolean
Dim lRow As Integer
Dim bFoundSetting As Boolean
Set mrgSetting = Nothing
bFoundSetting = False
mbAllowEditing = False
lRow = 2
Do Until IsEmpty(mwsSettings.Cells(lRow, 1))
If UCase(mwsSettings.Cells(lRow, 1).Value) = UCase(SettingName) Then
Set mrgSetting = mwsSettings.Cells(lRow, 1)
bFoundSetting = True
Exit Do
End If
lRow = lRow + 1
Loop
GetSetting = bFoundSetting
End Function
Private Sub UninitializedError()
Err.Raise vbObjectError + 101, "Setting Class", _
"The setting has not been properly initialized. Use the GetSetting method to initialize the setting."
End Sub
Private Sub ReadOnlyError()
Err.Raise vbObjectError + 102, "Setting Class", _
"The setting you are trying to change is " & _
"either read-only, requires a password, or you have not put the object in edit mode. " & _
"Using the EditMode method ."
End Sub
Private Sub Class_Initialize()
'don't allow editing by default
mbAllowEditing = False
'need to point the mwsWorksheet variable to the settings worksheet
'WorksheetExists，见代码清单7.2
If WorksheetExists(ThisWorkbook, SETTING_WORKSHEET) Then
Set mwsSettings = ThisWorkbook.Worksheets(SETTING_WORKSHEET)
Else
Set mwsSettings = Nothing
Err.Raise vbObjectError + 100, "Setting Class", _
"the worksheet named " & SETTING_WORKSHEET & " could not be located."
End If
End Sub
'validate password by comparing it against the value given by the password setting on the settings worksheet.
'Obviously, this assumes that the worksheet is managed such that it cann't be easily retrieved / discovered.
'WARNING: this provides only very basic security and should not be used to protect sensitive data.
Private Function ValidPassword(sPassword As String) As Boolean
Dim oSetting As Setting
Dim bValid As Boolean
bValid = False
Set oSetting = New Setting
If oSetting.GetSetting("Password") Then
If oSetting.Value = sPassword Then
bValid = True
Else
bValid = False
End If
Else
bValid = False
End If
Set oSetting = Nothing
ValidPassword = bValid
End Function
Private Sub ExecuteEventHandler()
On Error Resume Next
'make sure there is an event handler for the setting
If Len(Me.EventHandler) <> 0 Then
'call the procedure specified by the eventhandler property
'Application.Run "要运行的过程名字"
Application.Run Me.EventHandler
End If
End Sub
12.6 使用Settings收集Setting对象
代码清单12.2： Settings类--由Setting对象组成的伪集合类
代码
'代码清单12.2： Settings类--由Setting对象组成的伪集合类
'class constants
Private Const SETTINGS_WORKSHEET = "Settings"
Private Const NAME_COLUMN = 1
Private Const VALUE_COLUMN = 2
'class variables
Private mwsSettings As Worksheet
'count of settings
Public Property Get Count() As Long
Count = mwsSettings.Cells(65536, 1).End(xlUp).Row - 1
End Property
'add a new setting. returns setting object
'associated with the new setting.
Public Function add(Name As String) As Setting
Dim lRow As Long
Dim oSetting As Setting
'make sure a setting with this name doesn't already exist
If Not SettingExists(Name) Then
'find the last used row and move down one row
lRow = mwsSettings.Cells(65536, 1).End(xlUp) + 1
'add the name of the new setting
mwsSettings.Cells(lRow, 1) = Name
'set a reference to it
Set oSetting = Me.Item(Name)
Else
'the item already exists
Err.Raise vbObjectError + 201, "Settings Class", _
"A setting named " & Name & " already exists."
Set oSetting = Nothing
End If
End Function
'deletes ALL settings
Public Function Delete() As Boolean
mwsSettings.Range(mwsSettings.Cells(2, 1), mwsSettings.Cells(65536, 4)).ClearContents
Delete = True
End Function
'retrieves a setting by index or name
'retrieves by index if index is numeric
'retrieves by name if nameis not numeric
Public Function Item(Index As Variant) As Setting
Dim lRow As Long
Dim lFoundRow As Long
Dim oSetting As Setting
Dim sName As String
Set oSetting = New Setting
'if index is numeric then assume that we are looking by index
'if idex is not numeric then assume that we are looking by name
If IsNumeric(Index) Then
'get the name of the setting associated with the index.
'row of setting = index + 1 (header row)
sName = mwsSettings.Cells(Index + 1, 1).Value
'make sure we got a name rather than an empty cell
If Len(sName) <> 0 Then
'set a reference to the setting
If oSetting.GetSetting(sName) Then
Set Item = oSetting
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
Else
If oSetting.GetSetting(CStr(Index)) Then
Set Item = oSetting
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
End If
End Function
'performs a reverse-lookup. look up a setting by value rather than by name.
Public Function ItemByValue(Value As Variant) As Setting
Dim lRow As Long
Dim oSetting As Setting
Dim bFound As Boolean
Set oSetting = New Setting
bFound = False
For lRow = 2 To mwsSettings.Cells(65536, 1).End(xlUp).Row
If Value = mwsSettings.Cells(lRow, VALUE_COLUMN).Value Then
If oSetting.GetSetting(mwsSettings.Cells(lRow, NAME_COLUMN).Value) Then
Set ItemByValue = oSetting
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
bFound = True
Exit For
End If
Next
If Not bFound Then
Set ItemByValue = Nothing
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
End Function
Private Sub Class_Initialize()
'need to point the mwsWorksheet variable to the settings worksheet
'WorksheetExists见代码清单7.2
If WorksheetExists(ThisWorkbook, SETTINGS_WORKSHEET) Then
Set mwsSettings = ThisWorkbook.Worksheets(SETTINGS_WORKSHEET)
Else
Set mwsSettings = Nothing
Err.Raise vbObjectError + 200, "Settings Class", _
"the worksheet named " & SETTINGS_WORKSHEET & " could not be located."
End If
End Sub
Private Function SettingExists(SettingName As String) As Boolean
Dim oSetting As Setting
On Error GoTo SettingExistsErr
Set oSetting = Me.Item(SettingName)
SettingExists = True
Set oSetting = Nothing
Exit Function
SettingExistsErr:
SettingExists = False
End Function
'class constants
Private Const SETTINGS_WORKSHEET = "Settings"
Private Const NAME_COLUMN = 1
Private Const VALUE_COLUMN = 2
'class variables
Private mwsSettings As Worksheet
'count of settings
Public Property Get Count() As Long
Count = mwsSettings.Cells(65536, 1).End(xlUp).Row - 1
End Property
'add a new setting. returns setting object
'associated with the new setting.
Public Function add(Name As String) As Setting
Dim lRow As Long
Dim oSetting As Setting
'make sure a setting with this name doesn't already exist
If Not SettingExists(Name) Then
'find the last used row and move down one row
lRow = mwsSettings.Cells(65536, 1).End(xlUp) + 1
'add the name of the new setting
mwsSettings.Cells(lRow, 1) = Name
'set a reference to it
Set oSetting = Me.Item(Name)
Else
'the item already exists
Err.Raise vbObjectError + 201, "Settings Class", _
"A setting named " & Name & " already exists."
Set oSetting = Nothing
End If
End Function
'deletes ALL settings
Public Function Delete() As Boolean
mwsSettings.Range(mwsSettings.Cells(2, 1), mwsSettings.Cells(65536, 4)).ClearContents
Delete = True
End Function
'retrieves a setting by index or name
'retrieves by index if index is numeric
'retrieves by name if nameis not numeric
Public Function Item(Index As Variant) As Setting
Dim lRow As Long
Dim lFoundRow As Long
Dim oSetting As Setting
Dim sName As String
Set oSetting = New Setting
'if index is numeric then assume that we are looking by index
'if idex is not numeric then assume that we are looking by name
If IsNumeric(Index) Then
'get the name of the setting associated with the index.
'row of setting = index + 1 (header row)
sName = mwsSettings.Cells(Index + 1, 1).Value
'make sure we got a name rather than an empty cell
If Len(sName) <> 0 Then
'set a reference to the setting
If oSetting.GetSetting(sName) Then
Set Item = oSetting
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
Else
If oSetting.GetSetting(CStr(Index)) Then
Set Item = oSetting
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
End If
End Function
'performs a reverse-lookup. look up a setting by value rather than by name.
Public Function ItemByValue(Value As Variant) As Setting
Dim lRow As Long
Dim oSetting As Setting
Dim bFound As Boolean
Set oSetting = New Setting
bFound = False
For lRow = 2 To mwsSettings.Cells(65536, 1).End(xlUp).Row
If Value = mwsSettings.Cells(lRow, VALUE_COLUMN).Value Then
If oSetting.GetSetting(mwsSettings.Cells(lRow, NAME_COLUMN).Value) Then
Set ItemByValue = oSetting
Else
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
bFound = True
Exit For
End If
Next
If Not bFound Then
Set ItemByValue = Nothing
Err.Raise 9, "Settings Class", "Subscript out of range."
End If
End Function
Private Sub Class_Initialize()
'need to point the mwsWorksheet variable to the settings worksheet
'WorksheetExists见代码清单7.2
If WorksheetExists(ThisWorkbook, SETTINGS_WORKSHEET) Then
Set mwsSettings = ThisWorkbook.Worksheets(SETTINGS_WORKSHEET)
Else
Set mwsSettings = Nothing
Err.Raise vbObjectError + 200, "Settings Class", _
"the worksheet named " & SETTINGS_WORKSHEET & " could not be located."
End If
End Sub
Private Function SettingExists(SettingName As String) As Boolean
Dim oSetting As Setting
On Error GoTo SettingExistsErr
Set oSetting = Me.Item(SettingName)
SettingExists = True
Set oSetting = Nothing
Exit Function
SettingExistsErr:
SettingExists = False
End Function
12.7 伪集合类的使用局限
代码清单12.3：对Settings应用迭代的无效尝试
代码
'代码清单12.3：对Settings应用迭代的无效尝试
'This does not work. the settings object does not
'natively know how to iterate over all of the objects it contains.
Sub BadPrintOutAllSettings()
Dim oSettings As Settings
Dim oSetting As Setting
Set oSettings = New Settings
'this does not work
For Each oSetting In oSettings
Debug.Print oSetting.Name & " = " & oSetting.Value
Next
Set oSetting = Nothing
Set oSettings = Nothing
End Sub
'This does not work. the settings object does not
'natively know how to iterate over all of the objects it contains.
Sub BadPrintOutAllSettings()
Dim oSettings As Settings
Dim oSetting As Setting
Set oSettings = New Settings
'this does not work
For Each oSetting In oSettings
Debug.Print oSetting.Name & " = " & oSetting.Value
Next
Set oSetting = Nothing
Set oSettings = Nothing
End Sub
代码清单12.4：成功（手工）的Settings迭代
代码
'代码清单12.4：成功（手工）的Settings迭代
Sub PrintOutAllSettings()
Dim oSettings As Settings
Dim oSetting As Setting
Dim nIndex As Integer
Set oSettings = New Settings
'this does not work
For nIndex = 0 To oSettings.Count
Set oSetting = oSettings.Item(nIndex)
Debug.Print oSetting.Name & " = " & oSetting.Value
Next
Set oSetting = Nothing
Set oSettings = Nothing
End Sub
Sub PrintOutAllSettings()
Dim oSettings As Settings
Dim oSetting As Setting
Dim nIndex As Integer
Set oSettings = New Settings
'this does not work
For nIndex = 0 To oSettings.Count
Set oSetting = oSettings.Item(nIndex)
Debug.Print oSetting.Name & " = " & oSetting.Value
Next
Set oSetting = Nothing
Set oSettings = Nothing
End Sub
12.8 使那些设置工作起来
代码清单12.5：高质量的类感觉上就像Excel的内在功能
代码
'代码清单12.5：高质量的类感觉上就像Excel的内在功能
Sub DemonstrateSettings()
Dim oSettings As Settings
Dim oSetting As Setting
Set oSettings = New Settings
'add a setting
Set oSetting = oSettings.add("Test New Setting")
With oSetting
.ChangeEditMode True
.Description = "This is a test setting."
.Value = "Testing"
.EventHandler = "SayHello"
End With
'Check out EventHandler
oSetting.Value = "show me the event handler!"
Sub DemonstrateSettings()
Dim oSettings As Settings
Dim oSetting As Setting
Set oSettings = New Settings
'add a setting
Set oSetting = oSettings.add("Test New Setting")
With oSetting
.ChangeEditMode True
.Description = "This is a test setting."
.Value = "Testing"
.EventHandler = "SayHello"
End With
'Check out EventHandler
oSetting.Value = "show me the event handler!"
'Delete the setting
oSetting.Delete
Set oSetting = Nothing
Set oSettings = Nothing
End Sub
Sub SayHello()
MsgBox "Hello"
End Sub
