После выполнения макроса на экране появится окно, в котором отобразится первое из имен с предложением его удалить. При утвердительном ответе на данный запрос имя будет сразу же удалено, а в окне отобразится следующее имя и аналогичный запрос (переход к следующему имени осуществляется независимо от ответа на запрос относительно предыдущего имени) и т. д. Подобным образом можно быстро просмотреть все хранящиеся в рабочей книге имена и удалить ненужные.

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

Сортировка листов в текущей рабочей книге

При работе с файлами, содержащими большое количество рабочих листов, иногда возникает необходимость систематизировать их расположение путем сортировки в порядке возрастания (по номерам или по алфавиту). Решить эту задачу поможет макрос, код которого приведен в листинге 2.8.

Sub SortSheets()

Dim astrSheetNames() As String ' Массив для хранения имен

листов

Dim intSheetCount As Integer

Dim i As Integer

Dim objActiveSheet As Object

' Если нет активной рабочей книги – закрыть процедуру

If ActiveWorkbook Is Nothing Then Exit Sub

' Проверка защищенности структуры рабочей книги

If ActiveWorkbook.ProtectStructure Then

' Сортировка листов защищенной рабочей книги невозможна

MsgBox "Структура книги " & ActiveWorkbook.Name & _

« защищена. Сортировка листов невозможна.», _

vbCritical

Exit Sub

End If

' Сохраняем ссылку на активный лист книги

Set objActiveSheet = ActiveSheet

' Отключение сочетания клавиш Ctrl+Pause Break

Application.EnableCancelKey = xlDisabled

' Отключение обновления экрана

Application.ScreenUpdating = False

intSheetCount = ActiveWorkbook.Sheets.Count

' Заполнение массива astrSheetNames именами листов книги

ReDim astrSheetNames(1 To intSheetCount)

For i = 1 To intSheetCount

astrSheetNames(i) = ActiveWorkbook.Sheets(i).Name

Next i

' Сортировка массива имен в порядке возрастания

Call Sort(astrSheetNames)

' Перемещение листов книги

For i = 1 To intSheetCount

ActiveWorkbook.Sheets(astrSheetNames(i)).Move _

ActiveWorkbook.Sheets(i)

Next i

' Переход на исходный рабочий лист

objActiveSheet.Activate

' Включение обновления экрана

Application.ScreenUpdating = True

' Включение сочетания клавиш Ctrl+Pause Break

Application.EnableCancelKey = xlInterrupt

End Sub

Sub Sort(astrNames() As String)

' Сортировка массива строк по алфавиту (в порядке возрастания)

Dim i As Integer, j As Integer

Dim strBuffer As String

Dim fBuffer As Boolean

For i = LBound(astrNames) To UBound(astrNames) – 1

For j = i + 1 To UBound(astrNames)

If astrNames(i) > astrNames(j) Then

' Меняем i-й и j-й элементы массива местами

strBuffer = astrNames(i)

astrNames(i) = astrNames(j)

astrNames(j) = strBuffer

End If

Next j

Next i

End Sub