Поиск данных нештатными средствами

Листинг 3.62.Поиск данных с помощью макроса

Sub CustomSearch()

Dim strFindData As String

Dim rgFound As Range

Dim i As Integer

' Ввод строки для поиска

strFindData = InputBox("Введите данные для поиска")

' Просмотр всех рабочих листов книги

For i = 1 To Worksheets.Count

With Worksheets(i).Cells

' Поиск на i-м листе

Set rgFound = .Find(strFindData, LookIn:=xlValues)

If Not rgFound Is Nothing Then

' Ячейка с заданным значением найдена - выделим ее

Sheets(i).Select

rgFound.Select

Exit Sub

End If

End With

Next

' Поиск завершен. Ячейка не найдена

MsgBox ("Поиск не дал результатов")

End Sub

Включение автофильтра с помощью макроса

Листинг 3.63.Включение автофильтра

SubEnableAutoFilter()

On Error Resume Next

Selection.AutoFilter

EndSub

Трюки с форматированием

Изменение формата представления чисел нештатными средствами

Листинг 3.64.Формат «два знака после запятой»

Sub ChangeNumberFormat()

Selection.NumberFormat = "0.00"

End Sub

Листинг 3.65.Использование разделителя по разрядам

Sub ThreeNullSepatator()

Selection.NumberFormat = "#,##"

End Sub

Листинг 3.66. Изменение формата

Sub ChangeNumerFormatEx()

Selection.NumberFormat = "#,##0.00"

End Sub

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

Листинг 3.67.Помещение последнего символа над строкой

SubLastCharUp()

' Изменение расположения последнего символа ячейки

With ActiveCell.Characters(Start:=Len(Selection), Length:=1).Font

.Superscript = True

End With

End Sub

Создание нестандартной рамки

Листинг 3.68.Нестандартная рамка

Sub ChangeSelGrid()

' Оформление границ выделения

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

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 = xlHairline

.ColorIndex = xlAutomatic

EndWith

' Горизонтальные линии сетки

With Selection.Borders(xlInsideHorizontal)

.LineStyle = xlContinuous

.Weight = xlHairline

.ColorIndex = xlAutomatic

End With

End Sub

Быстрая вставка фамилий должностных лиц в документ

Листинг 3.69.Вставка текста в документ

SubInsertCustomText()

' Заполнение текущей ячейки

ActiveCell= "Генеральный директор"

Selection.Font.Bold=True

' Фамилия на три столбца правее должности

Cells(ActiveCell.Row, ActiveCell.Column + 3).Select

ActiveCell.FormulaR1C1 = "А. Б. Рублев"

Selection.Font.Bold = True

' Ячейка с "Главный бухгалтер" на три столбца левее _

и на три строки ниже ячейки с фамилией директора

Cells(ActiveCell.Row + 3, ActiveCell.Column - 3).Select

ActiveCell = "Главный бухгалтер"

Selection.Font.Bold = True

' Фамилия на три столбца правее должности

Cells(ActiveCell.Row, ActiveCell.Column + 3).Select

ActiveCell = "Т. С. Копейкин"

Selection.Font.Bold = True

EndSub