Алексей Гладкий - Excel. Трюки и эффекты

Selection.Borders(xlInsideVertical).LineStyle = xlNone

Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

End Sub

Sub DrowCrosswordGrid()

' Процедура начертания сетки кроссворда

' Задание цвета всех ячеек кроссворда

Selection.Interior.ColorIndex = 35

' Линии по диагонали не нужны

Selection.Borders(xlDiagonalDown).LineStyle = xlNone

Selection.Borders(xlDiagonalUp).LineStyle = xlNone

' Задание начертания границ всех диапазонов, входящих _

в выделение, а также границ между соседними ячейками _

всех диапазонов

On Error Resume Next

' Левые границы

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Правые границы

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Верхние границы

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Нижние границы

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Вертикальные границы между ячейками

With Selection.Borders(xlInsideVertical)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

' Горизонтальные границы между ячейками

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.Weight = xlThin

.ColorIndex = xlAutomatic

End With

End Sub

Sub DisplayGrid()

' Включение сетки на листе

ActiveWindow.DisplayGridlines = True

End Sub

Sub HideGrid()

' Выключение сетки на листе

ActiveWindow.DisplayGridlines = False

End Sub

Sub AutoNumber()

' Нумерация клеток, являющихся началом слов

Dim intRow As Integer ' Текущая строка

Dim intCol As Integer ' Текущий ряд

Dim cell As Range ' Текущая ячейка (с координатами _

(intRow, intCol))

Dim fTop As Boolean ' = True, если cell имеет соседей сверху

Dim fBottom As Boolean ' = True, если cell имеет соседей снизу

Dim fLeft As Boolean ' = True, если cell имеет соседей слева

Dim fRight As Boolean ' = True, если cell имеет соседей справа

Dim intDigit As Integer ' Текущий номер слова в кроссворде

intDigit = 1 ' Нумерация слов с 1

' Проходим по всем клеткам диапазона, используемого _

для кроссворда, сверху вниз слева направо и анализируем _

каждую угловую и крайнюю (левую и верхнюю) ячейки

For intRow = dhcMinRow To dhcMaxRow

For intCol = dhcMinCol To dhcMaxCol

' Текущая ячейка

Set cell = Cells(intRow, intCol)

' Проверка, входит ли ячейка в кроссворд (по ее цвету)

If cell.Interior.ColorIndex = 35 Then

fLeft = False

fRight = False

fTop = False

fBottom = False

On Error Resume Next

' Определение наличия соседей у ячейки...

' сверху

fTop = cell.Offset(-1, 0).Interior.ColorIndex = 35

' снизу

fBottom = cell.Offset(1, 0).Interior.ColorIndex = 35

' слева

fLeft = cell.Offset(0, -1).Interior.ColorIndex = 35

' справа

fRight = cell.Offset(0, 1).Interior.ColorIndex = 35

On Error GoTo 0

' Анализ положения ячейки

If (Not fTop And Not fLeft) Or _

(Not fBottom And Not fLeft And fRight) Or _

(Not fLeft And fRight) Or _

(Not fTop And fBottom) Then

' Ячейка подходит для начала слова

SetDigit intDigit, cell

intDigit = intDigit + 1

End If

End If

Next intCol

Next intRow

End Sub

Sub SetDigit(intDigit As Integer, cell As Range)

' Вставка цифры intDigit в ячейку, заданную параметром cell

cell.Value = intDigit

' Изменение настроек шрифта так, чтобы было похоже _

на настоящий кроссворд

' Маленький размер шрифта

cell.Font.Size = 6

' Выравнивание текста по левому верхнему углу ячейки

cell.HorizontalAlignment = xlLeft

cell.VerticalAlignment = xlTop

End Sub

Sub ToPrint()

' Удаление цветовой подсветки кроссворда

Cells.Interior.ColorIndex = xlNone

End Sub

Sub ToNumber()

' Закрытие первой формы и переход ко второй

UserForm1.Hide

UserForm2.Show

End Sub

Листинг 5.1 состоит из девяти макросов (семь первых можно запускать вручную):

• DrowCrosswordGrid – рисует сетку кроссворда для выделенных ячеек;

• Clear – удаляет кроссворд с рабочего листа;

• Clear Grid – удаляет рамку кроссворда в выделенных ячейках;

• AutoNumber – записывает номера в ячейки кроссворда;

• DisplayGrid – показывает сетку рабочего листа;

• Hide Grid – убирает сетку рабочего листа;

• ToPrint – удаляет цветовую подсветку ячеек кроссворда;

• SetDigit – помещает нужное число в указанную ячейку (этот макрос используется макросом AutoNumber для записи номеров в ячейки);

• ToNumber – переход от основной формы ко второй форме (см. ниже).

Вызывать все эти макросы вручную довольно неудобно. Их можно запускать посредством элементов управления, которые можно поместить прямо на рабочий лист или на пользовательскую форму. О создании пользовательской формы рассказывается в следующем подразделе.

Для создания основной формы программы необходимо воспользоваться вкладкой Разработчик, отображение которой включается в настройках программы в разделе Основные с помощью флажка Показывать вкладку «Разработчик» на ленте. На данной вкладке нужно по обычным правилам создать форму, изображенную на рис. 5.1.

Рис. 5.1. Первая форма программы