Готовые макросы в vba excel, Миронов Глава Макросы 9

• Название: Готовые макросы в vba excel, Миронов Глава Макросы 9
• Дата: 06.02.2018
• Размер: 1.35 Mb.
• Имя файла: 33980_7d1642e70814394f108d07a8a2edd23e.doc
• Тип: Документы; #35930
• страница: 33 из 47

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

Листинг 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

Глава . ДИАЛОГОВЫЕ ОКНА

Функция INPUTBOX (через ввод значения)

Public Sub ИнпутБокс()

Dim текст As Variant

MsgBox "Если в InputBox нажать Отмена, в ячейке будут удалены все данные"

текст = InputBox("Введите текст", "Окно ввода текста", "222")

MsgBox текст

If текст <> "" Then

Range("H7") = текст

MsgBox "Как сделать так, чтобы при выборе пользователем в InputBox - Отмена он закрывался и прекращалось выполнение процедуры?"

Else

Exit Sub

End If

End Sub