Создание цветной границы диапазона

Листинг 2.33.Оформление верхней и нижней границ диапазона

Sub RangeBorder()

Dim rgRange As Range

Set rgRange = Range("B2:D5")

' Оформление верхней границы диапазона

With rgRange.Borders(xlEdgeTop)

.Weight = xlThick

.LineStyle = xlContinuous

.Color = RGB(0, 0, 255)

EndWith

' Оформление нижней границы диапазона

With rgRange.Borders(xlEdgeBottom)

.Weight = xlMedium

.LineStyle = xlDash

.Color = RGB(255, 0, 255)

End With

EndSub

Автоматическое определение адреса ячейки

Листинг 2.34.Информация об адресе активной ячейки

Sub Worksheet_SelectionChange(ByVal Target As Range)

' Вывод адреса ячейки в различных форматах

MsgBox Target.Address() & vbCr & _

Target.Address(RowAbsolute:=False) & vbCr & _

Target.Address(ReferenceStyle:=xlR1C1) & vbCr & _

Target.Address(ReferenceStyle:=xlR1C1, _

RowAbsolute:=False, ColumnAbsolute:=False, _

RelativeTo:=Worksheets(1).Cells(2, 2))

EndSub

Автоматизация добавления примечаний в указанном диапазоне

Листинг 2.35.Добавление примечаний в диапазон

SubCreateComments()

DimcellAsRange

' Производим поиск по всем ячейкам диапазона и добавляем примечания _

ко всем ячейкам, содержащим слово "Выручка"

For Each cell In Range("B1:B100")

If cell.Value Like "*Выручка*" Then

cell.ClearComments

cell.AddComment "Неучтенная наличка"

End If

Next

End Sub

Заливка диапазона

Листинг 2.36.Создание заливки диапазона

SubFillRange()

' Заливка диапазона

WithRange("B1:E10")

' Задаем узор - сетчатый

.Interior.Pattern = xlPatternChecker

' Цвет узора - синий

.Interior.PatternColor = RGB(0, 0, 255)

' Цвет ячейки - красный

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

End With

End Sub

Ввод строго ограниченных значений в указанный диапазон

Ввод данных с помощью диалогового окна

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

Sub DialogInputData()

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

DimstrInputAsString' Введенная пользователем строка

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

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

ExitDo

EndIf

EndIf

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

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

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

Loop

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

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

End Sub