Основы офисного программирования и язык VBA

       

Свойства класса: имя, отчество, фамилию,


Option Explicit
'Класс Личность ' Свойства класса: имя, отчество, фамилию, дату рождения 'закроем от прямого доступа, 'получить и изменить их можно только через методы класса Private Имя As String Private Отчество As String Private Фамилия As String Private ДатаРождения As Date
Public Sub InitPerson(ByVal FN As String, ByVal LN As String, _ ByVal DoB As Date) 'Инициализация личности Имя = FN Фамилия = LN ДатаРождения = DoB End Sub
Public Sub PrintPerson() 'Печать в отладочном окне Immediate Dim S As String If WhoIs Then S = "родилась" Else S = "родился" Debug.Print Имя, Отчество, Фамилия, S, ДатаРождения End Sub
Public Sub CopyPerson(You As Личность) Имя = You.ВашеИмя Фамилия = You.ВашаФамилия ДатаРождения = You.ВашаДатаРождения End Sub
Public Function WhoIs() As Boolean 'Пытается определить пол личности, анализируя имя и фамилию 'Возвращает True, если думает, что имеет дело с женщиной. Dim F1 As Boolean, F2 As Boolean F1 = ПоследняяБуква(Имя) = "А" Or ПоследняяБуква(Имя) = "Я" F2 = ПоследняяБуква(Фамилия) = "А" Or ПоследняяБуква(Фамилия) = "Я" If F1 And F2 Then 'можно полагать, что наша Личность - женщина WhoIs = True ElseIf Not F1 And Not F2 Then WhoIs = False Else 'Есть сомнения If Отчество = "" Then Отчество = InputBox(Имя & " " & Фамилия _ & "! " & "Назовите отчество, пожалуйста.") End If WhoIs = ПоследняяБуква(Отчество) = "А" End If End Function
Public Sub SayWhoIs() ' Вывод сообщения о поле и возрасте личности If WhoIs Then MsgBox ("Думаю," & Имя & _ ", Вы из прекрасной половины человечества!") ElseIf Year(ДатаРождения) > 1967 Then MsgBox ("Думаю, " & Имя & ", Вы - молодой человек!") Else MsgBox ("Думаю, " & Фамилия & ", - мужчина!") End If End Sub
Private Function ПоследняяБуква(ByVal W As String) As String 'Внутренняя функция: возвращает в верхнем регистре 'последнюю букву слова W ПоследняяБуква = UCase(Right(W, 1)) End Function
Public Property Get ВашеИмя() As String ВашеИмя = Имя End Property
Public Property Let ВашеИмя(ByVal vNewValue As String) Имя = vNewValue End Property Public Property Get ВашеОтчество() As String ВашеОтчество = Отчество End Property
Public Property Let ВашеОтчество(ByVal vNewValue As String) Отчество = vNewValue End Property
Public Property Get ВашаФамилия() As String ВашаФамилия = Фамилия End Property


Public Property Let ВашаФамилия(ByVal NewValue As String) Фамилия = NewValue End Property
Public Property Get ВашаДатаРождения() As Date ВашаДатаРождения = ДатаРождения End Property
Public Property Let ВашаДатаРождения(ByVal NewValue As Date) ДатаРождения = NewValue End Property
Private Sub Class_Initialize() Имя = "Адам" Фамилия = "Человек" ДатаРождения = #1/1/100# End Sub
Пример 4.1.
Закрыть окно




' Конструкторы класса Rational Private Sub Class_Initialize() 'Конструктор по умолчанию 'инициализирует рациональное число дробью 1/1 m = 1 n = 1 End Sub
Public Sub CreateRational(ByVal a As Integer, ByVal b As Integer) 'Собственный конструктор 'Выполняет довольно сложные действия, 'прежде чем свойства получат значения Dim d As Integer 'Наибольший общий делитель a и b If b = 0 Then MsgBox " Ошибка при создании рационального числа!" _ & Chr(13) & "Знаменатель не должен равняться 0." Else ' приведение знака If b < 0 Then b = -b: a = -a End If ' приведение к несократимой дроби d = nod(a, b) ' d - НОД(a,b) m = a \ d n = b \ d End If End Sub
' Скрытая функция вычисления НОД(m,n) Private Function nod(ByVal m As Integer, ByVal n As Integer) As Integer Dim p As Integer m = Abs(m): n = Abs(n) If n > m Then p = m: m = n: n = p End If Do p = m Mod n: m = n: n = p Loop Until n = 0 nod = m End Function
Пример 4.2.
Закрыть окно




'Класс Plan ' Свойство класса Private CurMonth As Integer 'Закрытый массив, играющий служебную роль Private Месяцы(1 To 12) As String
Private Sub Class_Initialize() CurMonth = Month(Now)
Месяцы(1) = "Январь": Месяцы(2) = "Февраль": Месяцы(3) = "Март" Месяцы(4) = "Апрель": Месяцы(5) = "Май": Месяцы(6) = "Июнь" Месяцы(7) = "Июль": Месяцы(8) = "Август": Месяцы(9) = "Сентябрь" Месяцы(10) = "Октябрь": Месяцы(11) = "Ноябрь": Месяцы(12) = "Декабрь" End Sub
Public Property Get ТекущийМесяц() As String ТекущийМесяц = Месяцы(CurMonth) End Property
Public Property Let ТекущийМесяц(ByVal NewValue As String) Dim i As Byte i = 1 Do While i <= 12 If Месяцы(i) = NewValue Then CurMonth = i Exit Do End If i = i + 1 Loop If i = 13 Then 'Неверно задан месяц CurMonth = Month(Now) End If End Property
Пример 4.3.
Закрыть окно




' Класс Группа Личностей Const РазмерГруппы As Byte = 25 'Свойства Private Group(1 To РазмерГруппы) As Личность
'Процедуры-свойства Public Property Get ЧленГруппы(num As Byte) As Личность 'Если номер корректен If (num >= 1) And (num <= РазмерГруппы) Then 'Если существует в группе личность с таким номером If Not (Group(num) Is Nothing) Then Set ЧленГруппы = Group(num) Else: MsgBox ("В группе нет человека с номером " & num) End If Else: MsgBox ("Некорректно задан номер в группе - " & num) End If End Property
Public Property Set ЧленГруппы(num As Byte, NewValue As Личность) 'Если номер корректен If (num >= 1) And (num <= РазмерГруппы) Then 'Если в группе нет личности с таким номером, то она создается If Group(num) Is Nothing Then Set Group(num) = NewValue Else: MsgBox ("В группе уже есть человек с номером " & num) End If Else: MsgBox ("Некорректно задан номер в группе - " & num) End If End Property
Public Sub Сведения() Dim i As Byte For i = 1 To РазмерГруппы If Not (Group(i) Is Nothing) Then Group(i).PrintPerson End If Next i End Sub
Пример 4.4.
Закрыть окно




Public Function Plus( a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational
u = m * a.Знаменатель + n * a.Числитель v = n * a.Знаменатель d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Plus = R End Function
Public Function Minus(a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational
u = m * a.Знаменатель - n * a.Числитель v = n * a.Знаменатель d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Minus = R End Function
Public Function Mult(a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational
u = m * a.Числитель v = n * a.Знаменатель d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Mult = R End Function
Public Function Divide(a As Rational) As Rational Dim d As Integer, u As Integer, v As Integer Dim R As New Rational u = m * a.Знаменатель v = n * a.Числитель If v = 0 Then MsgBox ("деление на нуль невозможно") Else d = nod(u, v) R.Числитель = u \ d R.Знаменатель = v \ d Set Divide = R End If End Function
Public Sub PrintRational() Debug.Print (m & "/" & n) End Sub
Пример 4.5.
Закрыть окно




Option Explicit Private WithEvents myFriendOne As Личность Private WithEvents myFriendTwo As Личность
Private Sub myFriendOne_ДеньРождения(Dat As Date) BirthDay (Dat) End Sub
Private Sub myFriendOne_ИзменениеФамилии(Fam As String, _ NewFam As String, Permission As Boolean) MsgBox ("Изменение фамилии " & Fam & " на " & NewFam & Chr(13) _ & "не разрешается.") Permission = False End Sub
Private Sub myFriendTwo_ДеньРождения(Dat As Date) BirthDay (Dat) End Sub
Private Sub myFriendTwo_ИзменениеФамилии(Fam As String, _ NewFam As String, Permission As Boolean) MsgBox ("Поздравляю с замужеством, дорогая " & _ Fam & "-" & NewFam & "!") Permission = True End Sub
Public Sub BirthDay(Dat As Date) Debug.Print Dat, "-", Now Select Case Day(Dat) Case Day(Now) MsgBox ("Сегодня День Рождения!") Case Is < Day(Now) MsgBox ("Вчера был День Рождения!") Case Else MsgBox ("Завтра День Рождения!") End Select
End Sub
Public Sub Connect() Set myFriendOne = FriendOne Set myFriendTwo = FriendTwo End Sub
Пример 4.6.
Закрыть окно




Option Explicit ' Модуль Примеры Public FriendOne As New Личность Public FriendTwo As New Личность Public FOne As New Личности
Public Sub Знакомство() 'Вызывается конструктор с параметрами 'и происходит знакомство с объектами FriendOne.InitPerson FN:="Станислав", LN:="Федотов", _ DOB:="21.05.39" FriendTwo.InitPerson FN:="Катя", LN:="Павлова", _ DOB:="22.03.79" FriendOne.PrintPerson FriendTwo.PrintPerson FriendOne.SayWhoIs FriendTwo.SayWhoIs 'Связывание с двойниками. 'Теперь объекты могут реагировать на события! FOne.Connect End Sub
Public Sub CallEvents() Dim DOB As Date
'Вызов методов приведет к возникновению событий! 'При замене фамилии возникнет событие ИзменениеФамилии 'Заметьте, не всегда фамилия будет изменена! FriendOne.ВашаФамилия = "Фидотов" FriendTwo.ВашаФамилия = "Волконская"
'При попытке узнать дату рождения 'может быть вызван обработчик события ДеньРождения. DOB = FriendOne.ВашаДатаРождения DOB = FriendTwo.ВашаДатаРождения FriendOne.PrintPerson FriendTwo.PrintPerson End Sub
Пример 4.7.
Закрыть окно



Содержание раздела