Файл: vba_2002.pdf

зователем диапазона, которое включает только непустые ячейки, содержащие текст и не содержащие формулы. Если этому условию не соответствует ни одна ячейка, то функция возвращает значение 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

'имеет значение 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>и щелкнув на кнопке Выделить в диалоговом окне Перейти.

Диалоговое окно Выделение группы ячеек имеет одну особенность. Обычно диалоговое окно работает с текущим выделенным диапазоном. Например, если выделен целый столбец, то результатом будет подмножество ячеек этого столбца. Но если выделена одна ячейка, то диалоговое окно работает со всем листом. Именно поэтому функция 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

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

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) позволяет удалять текст из выделенных ячеек. Определенное количество символов можно удалять в начале, в конце или в указанной позиции в середине ячейки.