Панель инструментов изменения числового формата ячейки

Листинг 2.42.Код в модуле рабочего листа

Sub Worksheet_Change(ByVal Target As Excel.Range)

Call UpdateToolbar

End Sub

Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)

Call UpdateToolbar

End Sub

Листинг 2.43. Код в стандартном модуле

Sub FastChangeNumberFormat()

Dim bar As CommandBar

Dim button As CommandBarButton

' Удаление существующей панели инструментов (если она есть)

On Error Resume Next

CommandBars("Числовой формат").Delete

OnErrorGoTo0

' Формирование новой панели

Set bar = CommandBars.Add

With bar

.Name = "Числовой формат"

.Visible = True

End With

' Создание кнопки

Set button = CommandBars("Числовой формат").Controls.Add _

(Type:=msoControlButton)

With button

.Caption = ""

.OnAction= "ChangeNumFormat"

.TooltipText= "Щелкните для изменения числового формата"

.Style=msoButtonCaption

EndWith

' Обновление созданной панели инструментов

Call UpdateToolbar

End Sub

Sub UpdateToolbar()

' Обновление панели инструментов (если она создана)

OnErrorResumeNext

' Изменение заголовка кнопки (на название формата выделенной ячейки)

CommandBars("Числовой формат").Controls(1).Caption = _

ActiveCell.NumberFormat

End Sub

SubChangeNumFormat()

' Отображение диалогового окна изменения формата ячейки

Application.Dialogs(xlDialogFormatNumber).Show

Call UpdateToolbar

EndSub

Тестирование скорости чтения и записи диапазонов

Листинг 2.44.Тестирование скорости чтения и записи диапазонов

Sub TableSpeedTest()

Dim alngData() As Long ' Массив с числами

DimlngCountAsLong' Количество элементов в массиве

DimdtStartAsDate' Хранит время (и даже дату) начала _

тестирования

DimstrArrayToTableAsString' Время записи в таблицу

Dim strTableToArray As String ' Время чтения из таблицы

Dim strMessage As String

Dim i As Long

' Подготовка диапазона ячеек

Range("A:A").ClearContents

' Ввод размера массива, формирование массива заданного размера

lngCount=InputBox("Введите количество элементов")

ReDimalngData(1TolngCount)

' Заполнение массива данными

For i = 1 To lngCount

alngData(i) = i

Nexti

' Перенос массива в таблицу

Application.ScreenUpdating = False

dtStart = Timer

For i = 1 To lngCount

Cells(i, 1) = i

Next i

strArrayToTable = Format(Timer - dtStart, "00:00")

' Чтение данных из таблицы обратно в массив

dtStart = Timer

For i = 1 To lngCount

alngData(i) = Cells(i, 1)

Next i

strTableToArray = Format(Timer - dtStart, "00:00")

Application.ScreenUpdating = True

' Вывод на экран результатов тестирования

strMessage= "Запись: " &strArrayToTable&vbCrLf& _

"Чтение: " & strTableToArray

MsgBox strMessage, , lngCount & " элементов"

End Sub

Разработка и применение полезных пользовательских функций Объединение данных диапазона

Листинг 2.45.ФункцияCouple

Function Couple(Diapazon)

' Объединение данных, содержащихся в ячейках диапазона _

Diapazon (разделитель между значениями - пробел)

' iCell - текущая ячейка

For Each iCell In Diapazon

' Сцепляются данные только заполненных ячеек

If IsEmpty(iCell) <> True Then

' Добавление значения ячейки в выходную строку

If Couple = "" Then

Couple = iCell

Else

Couple = Couple & " " & iCell

End If

End If

Next

End Function