Информатика. Книга 7 Быстрое размножение рабочей книги 7 Сохранение рабочей книги с именем, представляющим собой текущую дату 7

• Название: Книга 7 Быстрое размножение рабочей книги 7 Сохранение рабочей книги с именем, представляющим собой текущую дату 7
• Анкор: Информатика
• Дата: 16.05.2022
• Размер: 1.27 Mb.
• Имя файла: VBA_v_primerakh.doc
• Тип: Книга; #532661
• страница: 17 из 21

Глава 4. Трюки и эффекты с помощником

Мультфильм с помощником в главной роли

Листинг 4.1. «Танцующий» помощник

Sub RunAssistantDance()

Static intAction As Integer

' Заставляем помощника выполнять действие (всего 16)

DoAssistantAction intAction

intAction = intAction + 1

If intAction < 16 Then

' Следующее действие через 3 секунды

Application.OnTime Time + TimeValue("00:00:3"), _

"RunAssistantDance"

End If

End Sub

Sub DoAssistantAction(intAction As Integer)

Dim astAssistant As Assistant

Set astAssistant = Application.Assistant

' Помещаем помощника в центр активного окна

astAssistant.Top = Application.ActiveWindow.Top _

+ Application.ActiveWindow.Height / 2

astAssistant.Left = Application.ActiveWindow.Left _

+ Application.ActiveWindow.Width / 2

' Показываем помощника

astAssistant.On = True

astAssistant.Visible = True

' Показываем заданное параметром intAction действие

Select Case intAction

Case 0

astAssistant.Animation = msoAnimationAppear

Case 1

astAssistant.Animation = msoAnimationCheckingSomething

Case 2

astAssistant.Animation = msoAnimationBeginSpeaking

Case 3

astAssistant.Animation = msoAnimationCharacterSuccessMajor

Case 4

astAssistant.Animation = msoAnimationEmptyTrash

Case 5

astAssistant.Animation = msoAnimationGestureDown

Case 5

astAssistant.Animation = msoAnimationGestureLeft

Case 6

astAssistant.Animation = msoAnimationGestureRight

Case 7

astAssistant.Animation = msoAnimationGestureUp

Case 8

astAssistant.Animation = msoAnimationGetArtsy

Case 9

astAssistant.Animation = msoAnimationGetAttentionMajor

Case 10

astAssistant.Animation = msoAnimationGetAttentionMinor

Case 11

astAssistant.Animation = msoAnimationGetTechy

Case 12

astAssistant.Animation = msoAnimationGetWizardy

Case 13

astAssistant.Animation = msoAnimationGoodbye

Case 14

astAssistant.Animation = msoAnimationGreeting

Case 15

astAssistant.Animation = msoAnimationDisappear

End Select

End Sub

Дополнение помощника текстом, заголовком, кнопкой и значком

Листинг 4.2. Настройка помощника

Sub AssistantMessage()

Dim strTitle As String ' Заголовок сообщения

Dim strMessage As String ' Текст сообщения

' Содержимое заголовка и текста в окне помощника

strTitle = "Спрашивайте - ответим"

strMessage = "{cf 249}{ul 1} Руки мыли{ul 0}?" _

& vbCr & "{cf 6} Не забыть обновить антивирус!"

' Настраиваем помощника

With Application.Assistant

' Включаем и показываем помощника

.On = True

.Visible = True

' Создаем окно сообщения

With .NewBalloon

.BalloonType = msoBalloonTypeButtons

' Кнопка "ОК" в окне помощника

.button = msoButtonSetOK

' Значок в окне помощника

.Icon = msoIconAlert

' Заголовок в окне помощника

.Heading = strTitle

' Текст в окне помощника

.Text = strMessage

' Отображение окна

.Show

End With

End With

End Sub

Новые параметры помощника

Листинг 4.3. Новые параметры помощника

Sub AssistantCheckboxes()

Dim i As Integer

Dim strMessage As String

With Assistant

' Включение и отображение помощника

.On = True

.Visible = True

' Создание окна сообщения

With .NewBalloon

' Настройка окна...

' Тип окна

.BalloonType = msoBalloonTypeButtons

' Заголовок

.Heading = "Выберите страну"

' Добавление флажков

.CheckBoxes(1).Text = "Россия"

.CheckBoxes(2).Text = "США"

.CheckBoxes(3).Text = "Южная Африка"

.button = msoButtonSetOkCancel

' Отображение окна

If .Show = msoBalloonButtonOK Then

' Вывод информационного окна в зависимости _

от установленных флажков

For i = 1 To 3

If .CheckBoxes(i).Checked Then

strMessage = strMessage & _

.CheckBoxes(i).Text & vbCr

End If

Next

' Отображение окна сообщения (имеется в виду _

стандартное окно)

If Len(strMessage) = 0 Then

MsgBox "No choice."

Else

MsgBox strMessage

End If

End If

End With

End With

End Sub

Использование помощника для выбора цвета заливки

Листинг 4.4. Выбор цвета заливки рабочего листа

Sub AssistantChooseColor()

Dim intChoise As Integer

With Assistant

' Включение и отображение помощника

.On = True

.Visible = True

With .NewBalloon

' Настройка окна...

' Тип

.BalloonType = msoBalloonTypeButtons

' Заголовок

.Heading = "Какой нужен цвет?"

' Первый цвет

.Labels(1).Text = "Красный"

' Второй цвет

.Labels(2).Text = "Желтый"

' Третий цвет

.Labels(3).Text = "Зеленый"

' Тип кнопок

.button = msoButtonSetNone

' Оображение окна

intChoise = .Show

' Информационное сообщение о выбранном цвете

MsgBox "Выбран: " & .Labels(intChoise).Text

End With

End With

' Настройка цветов ячеек (присвоение выбранного цвета)

Select Case intChoise

Case 1

' Красный цвет

ActiveSheet.Cells.Interior.Color = RGB(255, 0, 0)

Case 2

' Желтый цвет

ActiveSheet.Cells.Interior.Color = RGB(255, 255, 0)

Case 3

' Зеленый цвет

ActiveSheet.Cells.Interior.Color = RGB(0, 255, 0)

End Select

End Sub