Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:

2 семестр / vba_2002

.pdf
Скачиваний:
82
Добавлен:
09.04.2015
Размер:
9.9 Mб
Скачать

зователем диапазона, которое включает только непустые ячейки, содержащие текст и не содержащие формулы. Если этому условию не соответствует ни одна ячейка, то функция возвращает значение N o t h i n g .

Функция CreateWorkRange (которая создает и возвращает объект Range) принимает два аргумента.

г — Объект Range. В данном случае это диапазон, выделенный пользователем и отображаемый в элементе управления RefE d i t .

TextOnly. Если аргумент имеет значение True, го созданный объект не будет содержать нетекстовые ячейки.

Функция CreateWorkRange, которая показана в листинге 16.4, является глобальной и универсальной, т.е. используется не только в утилите Text Tools.

Листинг 16.4. Функция CreateWorkRange

Function CreateWorkRange(r As Range, TextOnly As Boolean) As Range

'

Создает

объект Range, состоящий только из непустых ячеек

1

и ячеек,

которые не содержат формулы. Если TextOnly

'имеет значение True, то объект не содержит числовые ячейки

Set CreateWorkRange = Nothing

Select Case r.Count

Case 1 ' выделена одна ячейка

If r.HasFormula Then Exit Function

If TextOnly Then

If IsNumeric{r.Value) Then

Exi t Funct ion

Else

Set CreateWorkRange = r

End If

Else

If Not IsEmptyfr/ Then Set CreateWorkRange = r

End If

Case Else ' выделено более одной ячейки On Error Resume Next

If TextOnly Then

Set CreateWorkRange = _ r.SpecialCells(xlConstants, xlTextValues)

If Err <> 0 Then Exit Function

Else

Set CreateWorkRange = _

r .SpecialCells (xlConstants, xlTextValues + xlNumbers) If Err <> 0 Then Exit Function

End If End Select

End Function

Функция createworkRange активно использует свойство specialcell . Для того чтобы получить дополнительную информацию об этом свойстве, попытайтесь в диалоговом окне Excel Выделение группы ячеек записать макрос при создании различныхвыделений. Этодиалоговоеокноможноотобразить, нажавклавишу<F5>и щелкнув на кнопке Выделить в диалоговом окне Перейти.

ЧастьV.Совершенныеметодыпрограммирования

423

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

Если объект WorkRange создан, процедура ChangeCaseTab продолжает обрабатывать каждую ячейку в объекте WorkRange. Перед завершением продедуры становится доступной кнопка Отменить, и к ней добавляется подпись.

Далее в этой главе о возможности отмены операции речь пойдет более подробно.

Добавление текста

Вторая страница элемента управления M u l t i P a g e (рис. 16.5) позволяет добавлять текстовые символы в содержимое выделенной ячейки. Текст можно добавить в начало, в конец или в определенную позицию внутри ячейки.

Рис. 16.5. Эта страница позволяет добавлять текст всодержимое выделенныхячеек

Процедура ApplyButton__Click вызывает процедуру AddTextTab, если значение свойства Value элемента управления MultiPage; равно 1 (т.е. активна вторая страница элемента управления MultiPage) . Листинг 16.5 содержит полный код процедуры AddTextTab.

Листинг 16.5. Вставка проверенного текста в ячейки с помощью диалогового окна

Sub AddTextTab{)

Dim WorkRange As Range

Dim Cell As Range

Dim NewText As String

Dim InsPos As Integer

Dim CellCount As Long

Set WorkRange = _

CreateWorkRange(Range(RefEditl.Text), cblgnoreNonTextl)

If WorkRange Is Nothing Then Exit Sub

NewText = TextToAdd.Text

If NewText = "" Then Exit Sub

Проверить потенциально неправильные формулы

If

OptionAddToLeft And Left(NewText, 1) Like •[=+-]"

 

MsgBox "Это неправильная формула.", __

430

Глава IB. Разработка утилитExcelспомощью VBA

vblnfonnation, APPNAME With TextToAdd

.Selstart = 0

.SelLength = Len(.Text)

.SetPocus End With

Exit Sub End If

1Добавить текст в середину? If OptionAddToMiddle Then

InsPos = Val(InsertPos.Caption)

If InsPos = 0 Then Exit Sub

End If

' Циклически перебрать ячейки CellCount = О

ReDim LocalUndo(CellCount)

For Each Cell In WorkRange With Cell

Сохранить информацию для отмены CellCount = CellCount + 1

ReDim Preserve LocalUndo(CellCount) With LocalUndo(CellCount)

.OldText = Cell.Value

.Address = Cell.Address End With

If OptionAddToLeft Then .Value = NewText & .Value If OptionAddToRight Then .Value = .Value & NewText If OptionAddToMiddle Then

If InsPos > Len{.Value) Then

.Value = .Value & NewText

Else

.Value = Left(-Value, InsPos) & NewText & _ Right(.Value, Len<.Value) - InsPos)

End If End if

End With Next Cell

1Обновить кнопку Undo UndoButton.Enabled = True

UndoButton.Caption = "Отменить добавление текста"

End Sub

Эта процедура по своей структуре напоминает процедуру ChangeCaseTab. Обратите внимание, что она перехватывает ошибку, которая происходит, если пользователь вставляет символы +,- или = в начало ячейки. Такая вставка приведет к тому, что Excel будет интерпретировать полученное содержимое ячейки как неправильно составленную формулу.

Удаление текста

Третья страница элемента управления M u l t i P a g e (рис. 16.6) позволяет удалять текст из выделенных ячеек. Определенное количество символов можно удалять в начале, в конце или в указанной позиции в середине ячейки.

Часть V. Совершенные методы программирования

431

Рис.16.6,Этастраницапозволяетпользователюудалитьсимволывтекстевыделенныхячеек

Процедура ApplyButton_Click вызывает процедуру Remove Text Tab в том случае, если значение свойства Value элемента управления MultiPage равно 2 (т.е. акгивна третья страница элемента управления MultiPage). Листинг 16.6 содержит полный код процедуры Remove Тех t Tab.

Листинг 16.6. Удаление текста из ячеек с помощью диалогового окна

Sub RemoveTextTab()

Dim WorkRange As Range

Dim Cell As Range

Dim NumToDel As Integer

Dim CellCount As Long

1

1

Set WorkRange = _

CreateWorkRange(Range(RefEdit]..Text),cbIgnoreNonText2)

If WorkRange Is Nothing Then Exit Sub

NumToDel = Val(CharstoDelete.Caption)

If NumToDel = 0 Then Exit Sub

Обработать ячейки ReDim LocalUndo(0) CellCount я О

For Each Cell In WorkRange With Cell

Сохранить информацию для отмены CellCount = CellCount + 1

ReDim Preserve LocalUndo(CellCount) LocalUndo {CellCount) .OldText. = .Value LocalUndo(CellCount).Address = .Address

If LenfCell .Value) <= NumToDel Then __ NumToDel = Len(.Value)

Select Case True

Case OptionDeleteFroxnLeft

.Value = Right(.Value, Len(.Value) - NumToDel) Case OptionDeleteFromRight

.Value = Left(.Value, Len(.Value) - NumToDel) Case OptionDeleteFromMiddle

.Value = RemoveChars{-Value, _ CInt(BeginChar.Caption), NumToDel)

End Select End With

Next Cell

432

Глава 16, РазработкаутилитExcelспомощью VBA

'

Обновить кнопку Undo

 

UndoButton.Enabled = True

 

UndpButton.Caption = "Отменить удаление текста"

End

Sub

Процедура RemoveTextTab по своей структуре напоминает другие процедуры, которые вызываются из процедуры ApplyButton _ Click . Если возникает необходимость удаления СИМВОЛОВ из середины текста, то вызывается функция RemoveChars, которая выполняет эту задачу.

Функция RemoveChars показана ниже, Она удаляет указанное количество символов (и), начиная с позиции (Ь) в текстовой строке (t).

Private Function RemoveChars{t, b, n) As String Dim k As Integer

Dim Temp As String Temp = ""

For k = 1 To Len(t)

If k < b Or k >= b + n Then Temp = Temp & Mid{t, k, 1)

End If Next k

RemoveChars = Temp End Function

Удаление пробелов

Четвертая страница элемента управления M u l t i P a g e (рис. 16.7) предоставляет пользователю возможность удалить пробелы в выделенных ячейках.

Рис. 16.7. Эта страница позволяетудалить пробелы в выделенныхячейках

Процедура ApplyButton _ Click вызывает процедуру Remove Spaces Tab в том случае, если элемент управления M u l t i P a g e имеет значение 3 (т.е. активна четвертая страница элемента управления MultiPage). Листинг 16.7 содержит полный код процедуры RemoveSpacesTab.

Листинг 16.7. Фильтрация ненужных пробелов в текстовых ячейках

Sub RemoveSpacesTab()

Dim WorkRange As Range

Dim Cell As Range

Dim CellCount As Long

Set WorkRange = CreateWorkRange _

(Range(RefEditl.Text), True)

If WorkRange Is Nothing Then Exit Sub

Часть V. Совершенныеметоды программирования

433

Обработать ячейки CellCount = 0

ReDim LocalUndo(CellCount)

For Each Cell In WorkRange

With Cell

1Сохранить информацию для отмены CellCount = CellCount + 1

ReDim Preserve LocalUndo(CellCount) LocalUndo(CellCount).oldText - .Value LocalUndo(CellCount).Address = .Address Select Case True

Case OptionRemoveExcess

.Value = _

Application.WorkEiheeCFunction.Trim( .Value)

Case OptionRemoveLeft

.Value = LTrim(.Value)

Case OptionRemoveRight

.Value = RTrim{.Value)

Case OptionRemoveBoth

.Value = Trim(.Value)

Case OptionRemoveAllSpaces

.Value = RemoveSpaces(.Value)

End Select

End With

Next Cell

1Обновить кнопку Undo UndoButton.Enabled = True

UndoButton.Caption = "Отменить удаление пробелов"

End Sub

Обратите внимание, что первый вариант Удаление лишних пробелов требует использования функции Excel. Во втором и третьем варианте используются функции VBA. Последний вариант Удаление из текста всех пробелов реализован с помощью пользовательской функции, которая приводится ниже.

Private Function RemoveSpaces(t) As String

1Удаление всех пробелов в строке Dim NumChars As Integer

Dim i As Integer NumChars = Len(t) RemoveSpaces = ""

For i = 1 To NumChars

If Mid(t, i, 1) <> " " Then _

RemoveSpaces = RemoveSpaces & Mid(t, i, 1)

Next i

End Function

Методика отмены выполненных действий

В отличие от средства отмены действий, которое поддерживается в Excel, операция отмены выполненных действий, реализуемая в утилите Text Tools, является одноуровневой. Другими словами, пользователь может отменить только последнюю выполненную операцию. Обратитесь к врезке "Отмена действия процедуры VBA" для получения дополнительной информацииоботменевыполненныхдействийвсобственныхприложениях.

434

Глава 16. Разработка утилит Excel с помощью VBA

В утилите Text Tools в модуле modMain тип данных OrigData объявляется следующим образом.

Type OrigData

OldText As Variant

Address As String End Type

Тип данных OrigData состоит из двух элементов: OldText (содержит предыдущее содержимое ячейки) и Address (содержит адрес ячейки).

Каждая из четырех процедур создает массив (который называется LocalUndo) типа OrigData. Затем перед модификацией содержимого ячейки выполняется следующий код

' Сохранить информацию для отмены операции CellCount = CellCount + 1

ReDim Preserve LocalUndo(CellCount)

LocalUndo(CellCount).OldText = .Value

LocalUndo(CellCount).Address = .Address

На последнем этапе каждая из процедур обновляет состояние кнопки Отменить в пользовательском диалоговом окне FormMain. Например, код в процедуре RemoveTextTab выглядит следующим образом:

' Обновить состояние кнопки Undo UndoButton.Enabled = True

UndoButton.Caption = "Отменить удаление текста"

Когда каждая из этих процедур завершит работу, массив LocalUndo заполнится данными для отмены операции в каждой ячейке и адресом этой ячейки. Если пользователь щелкнет на кнопке Отменить, то будет выполнена процедура UndoButton_Click. Эта процедура содержит следующий код.

Private Sub UndoButton_Click() Dim i As Integer

Application.ScreenUpdating = False

1Восстановить предыдущее содержимое For i = 1 To UBound(LocalUndo)

Range(LocalUndo(i).Address).Value a LocalUndo{i).OldText Next i

Application.ScreenUpdating = True

1Обновить состояние кнопки Отменить UndoButton.Caption = "Undo"

UndoButton.Enabled = False End Sub

Эта процедура циклически просматривает массив LocalUndo и вставляет старое значение в каждую ячейку.

На Web-узле издательства содержится пример, который демонстрирует возможность использования команды Правка^Отмена после выполнения процедуры VBA.

Процедура ShowStats

Щелчок на кнопке Стат приводит к отображению окна сообщения, которое содержит информацию о содержимом выделенных ячеек. На рис. 16.8 показан пример такого окна сообщения.

Часть V. Совершенные методы программирования

435

Рис. 16.8. Щелчок на кнопке Стат щ котображениютакогоокнасообщ*

Отмена действия процедуры VBA

Пользователи компьютера уже привыкли к возможности отмены выполненных операций. Почти каждая операция, которая производится a Excel, может быть отменена. А с момента выхода Excel 97 в программе поддерживается несколько уровней отмены действий.

При программировании на VBA у вас возникнет вопрос, можно ли отменить результат выполнения процедуры. Ответ: да. Если быть более точным, то следует заметить, что добиться такого поведения не всегда легко.

Отмена результата выполнения процедуры VBA не выполняется по умолчанию. Процедура должна где-то сохранить информацию о предыдущем состоянии системы, чтобы его можно быть восстановить при выборе пользователем команды Правка^Отмена. Реализация такого подхода зависит от действий, которые выполняет процедура. В крайнем случае вам может понадобиться сохранить полностью весь лист. Если процедура изменяет диапазон ячеек, то необходимо программно сохранять содержимое этогодиапазона.

Объект Application содержит метод OnUndo, который позволяет программисту указать текст, появляющийся в меню Правка^Отмена, а также процедуру, которая выполняется при выборе пользователем команды Правка^Ютмена. Например, следующий оператор определяет опции Отмена подпись Отменить выполнение макроса. Если пользователь выберет Правка^Отменить выполнение макроса, то будет запущена процедура undaMyMacra.

Application.OnUndo "Отменить выполнение макроса", "UndoMyMacro"

В листинге 16.8 показан полный код процедуры отображения статистики для выделенных ячеек.

Листинг 16.8. Отображение информации о ячейках на рабочем листе

Private

Sub

StatsButton^Click()

 

'

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

 

Dim WorkRange

As

Range

 

 

Dim

NumWords

As

Integer

 

 

Dim

NumChars

As

Integer

 

 

Dim

CellLength As

Integer

 

 

Dim NonBlanks

As

Integer

 

 

Dim Cell

As Range

 

 

 

 

Dim

Msg As

String

 

 

 

 

Dim Words

As

Integer

 

 

 

Dim

Contents

As

String

 

 

Dim i As

Integer

 

 

 

 

1

Проверить

действительность ссылки на

диапазон

 

If

Not ValidReferencefRefEditl.Text)

Then

 

 

MsgBox "Неправильный диапазон.", vblnformation, APPNAME

 

 

With

RefEditl

 

 

 

 

 

 

.SelStart

=

0

 

 

 

 

.SelLength

=

100

 

 

 

 

.SetFocus

 

 

 

 

 

End

With

 

 

 

 

 

436

 

 

 

 

 

 

 

Глава 16. Разработка утилит Excelс помощью VBA

Exit Sub

End If

Set WorkRange = CreateWorkRange(Range(RefEditl.Text), _ True)

If WorkRange Is Nothing Then MsgBox _

11В диапазоне нет текстовых ячеек без формул.", _

 

vblnformation, APPNAME

 

 

 

Exit

Sub

 

 

 

End

if

 

 

 

 

 

NonBlanks

=

WorkRange.Count

 

 

NumWords = 0

 

 

 

 

NumChars = 0

 

 

 

 

For Each Cell In WorkRange

 

 

 

CellLength

= Len(Cell.Value)

 

 

NuinChars = NumChars + CellLength

 

 

Contents

=

Application.Trim(Cell.Value)

 

Words = 1

 

 

 

 

For i = 1 To Len(Contents)

 

 

 

If Mid(Contents, i, 1) = " " Then _

 

 

Words = Words + 1

 

 

 

Next

i

 

 

 

 

 

If Len(Contents) = 0 Then Words = 0

'Учет пустых ячеек

 

NumWords - NumWords + Words

 

Next

Cell

 

 

 

 

 

Msg = "Статистика выделения" & vbCrLf & vbCrLf

Msg = Msg &

"Непустые ячейки:"

& Chr(9)

& NonBlanks _

& Chr(13)

 

 

 

 

Hsg = Msg &

"Слова:" & Chr(9)

& Chr{9) & NumWords _

& Chr(13)

 

 

 

 

Msg = Msg & "Символы:" & Chr(9) & NumChars & Chr(13)

Msg = Msg &

"Средняя длина:" & Chr(9) & Format(NumChars _

/ NonBlanks,

"# . 00")

 

 

MsgBox Msg,

vblnformation, APPNAME

 

Exit

Sub

 

 

 

 

 

End Sub

 

 

 

 

 

 

Процедура ShowStats является достаточно объемной, но при этом очень простой. Обратите внимание, что проиедура проверяет действительность ссылки на диапазон (которая отображается в элементе управления Ref Edit ) и выдает сообщение об ошибке, если этот элемент управления содержит неверную ссылку.

Техника предоставления пользователю справки

Существует несколько способов предоставления пользователю справочной информации. Утилита Text Tools использует простую технику, которая предполагает извлечение текста, хранящегося на листе, и отображение этого текста в диалоговом окне U^erForm. Столбец А содержит названия разделов, а столбец В — текст разделов справочной системы. Названия разделов помещаются в элемент управления ComboBox, а содержимое раздела отображаечся

спомощью элемента управления Label.

Вглаве 24 описывается этот метод (а также некоторые другие) предоставления пользователюдоступаксправочнойинформации.

ЧастьV.Совершенныеметодыпрограммирования

437

На рис. 16.9 показано диалоговое окно, которое содержит справочную информацию. Это диалоговое окно (FormHelp) отображается после того, как пользователь щелкнет на кнопке Справка в диалоговом-окне FormMain.

Процедуры создания и удаления команд меню

Единственный элемент утилиты Text Tools, который ранее не рассматривался, — это команда меню, используемая для вызова утилиты Text Tools. После открытия рабочей книги запускается процедура Workbook_Open (которая находится в модуле ThisWorkbook). Эта процедура очень проста:

Private Sub Workbook_Open() Call GreateMenu

End Sub

Рис. 16.9. Справка отображается в пользовательском диалоговом окне с помощью •элементовуправленияComboBoxиLabel

Процедура Workbook^Bef oreClose выполняется перед закрытием рабочей книги. Она так же проста, как и предыдущая процедура:

Private Sub Workbook_BeforeClose(Cancel As Boolean) Call DeleteMenu

End Sub

Процедуры CreateMenu и DeleteMenu находятся в модуле VBA modMenus. Процедура CreateMenu добавляет команду в меню Сервис, а процедура DeleteMenu удаляет команду из меню Сервис. Этот код можно просмотреть самостоятельно.

Дополнительная информация о способах управления командами меню приводится в главе 23.

Оценка проекта

В предыдущих разделах представлено описание каждого из компонентов утилиты Text Tools. Пришло время пересмотреть первоначальные цели проекта, чтобы оценить возможность их достижения. Ниже приведены первоначальные цели проекта с дополнительными комментариями.

Утилита должна иметь тот лее внешний вид и поведение, что и остальные команды Excel. Другими словами, утилита будет предоставлять пользователю диалоговое окно, которое выглядит так же. как и другие диалогового окна Excel. Как было отмечено ранее, утилита Text Tools незначительно отходит от этого принципа, так как вместо кнопки ОК в ней используется кнопка Применить. Принимая во внимание критерий повышения удобства использования, на такое нарушение принципов поведения окон Excel можно согласиться.

438

Глава 1В. Разработка утят Excel с помощью VBA

Соседние файлы в папке 2 семестр