![](/user_photo/2706_HbeT2.jpg)
2 семестр / vba_2002
.pdf![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu431x1.jpg)
зователем диапазона, которое включает только непустые ячейки, содержащие текст и не содержащие формулы. Если этому условию не соответствует ни одна ячейка, то функция возвращает значение 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 |
![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu432x1.jpg)
Диалоговое окно Выделение группы ячеек имеет одну особенность. Обычно диалоговое окно работает с текущим выделенным диапазоном. Например, если выделен целый столбец, то результатом будет подмножество ячеек этого столбца. Но если выделена одна ячейка, то диалоговое окно работает со всем листом. Именно поэтому функция 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 |
![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu434x1.jpg)
![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu435x1.jpg)
' |
Обновить кнопку 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 |
![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu437x1.jpg)
В утилите 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 |
![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu438x1.jpg)
Рис. 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 |
![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu439x1.jpg)
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 |
![](/html/2706/567/html_twYuAfu26A.FaQl/htmlconvd-KN3qbu440x1.jpg)
На рис. 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 |