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

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

Вызов предварительного просмотра

Sub Test()

 With Application.Workbooks.Item("Test.xls")

 Sheets("Test").PrintPreview

 End With

End Sub

 

Настройка ввода данных в диалоговом окне

Sub DialogInputData()

Dim intMin As Integer, intMax As Integer ' Диапазон значений

Dim strInput As String              ' Введенная пользователем строка

Dim strMessage As String

Dim intValue As Integer

 

intMin = 1 ' Минимальное значение

intMax = 50 ' Максимальное значение

strMessage = "Введите значение от " & intMin & " до " & intMax

' Ввод значения (цикл завершается, когда пользователь вводит _

значение из заданного диапазона или отменяет ввод)

Do

strInput = InputBox(strMessage)

If strInput = "" Then Exit Sub ' Отмена ввода

' Проверка, содержит ли введенная пользователем строка число

If IsNumeric(strInput) Then

    intValue = CInt(strInput)

    ' Проверка, удовлетворяет ли значение диапазону

    If intValue >= intMin And intValue <= intMax Then

       ' Все условия выполнены

       Exit Do

    End If

End If

' Формирование сообщения с текстом ошибки

strMessage = "Вы ввели некорректное значение." & vbNewLine & _

  "Введите число от " & intMin & " до " & intMax

Loop

' Внесение данных в ячейку

ActiveSheet.Range("A1").Value = strInput

End Sub

Открытие диалогов о го окна (“Открыть файл”)_1

 

Sub Test()

Application.Dialogs(xlDialogOpen).Show "*.dbf"

End Sub

Открытие диалогов о го окна (“Открыть файл”)_2

fileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If fileToOpen <> False Then

MsgBox "Open " & fileToOpen

End If

Открытие диалогов о го окна (“Печать”)

Application.Dialogs(xlDialogPrint).Show

Другие диалоговые окна

xlDialogClear - очистка ячейки или диапазона

xlDialogDisplay - параметры отображения ячеек

xlDialogFileDelete - удаление файла

xlDialogSaveWorkbook - сохранить книгу

xlDialogSearch - поиск в документе

xlDialogWorkbookName - переименование листа

 

 

Вызов броузера из Экселя

Надо создать кнопку которой добавить код:

Sub Button1_Click()

           Call ShellExecute(GetDesktopWindow, "Open", "www.armentel.com/avb", "", "c:\", SW_SHOWNORMAL)

End Sub

 

И функция:

           Private Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal _

           lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, _

           ByVal nShowCmd As Long)

               

           Private Declare Function GetDesktopWindow Lib "user32" () As Long

               

           Const SW_SHOWNORMAL = 1

Диалоговое окно ввода данных

Sub InputDialog()

Dim strInput As String

' Вызов стандартного диалогового окна ввода данных

strInput = InputBox("Введите данные", "Ввод данных")

End Sub