В данной программе присутствуют некоторые особенности, которые необходимо отметить. Первая особенность – отключение обновления экрана на время перемещения страниц книги. Это сделано, чтобы исключить мерцание изображения во время перемещения листов. Вторая особенность – блокировка сочетания клавиш CtrL+Pause Break. Дело в том, что если остановить выполнение программы после того, как она отключила обновление изображения, то изображение в рабочей области книги не будет обновляться, то есть продолжать работать с книгой будет весьма проблематично.
Для сортировки листов формируется массив строк, элементами которого являются имена листов книги. Для сортировки массива с именами листов книги (процедура Sort) используется простая сортировка выбором. После того как массив отсортирован, листы книги расставляются в нужном порядке (последний цикл программы).
После запуска данного макроса (для удобства можно назначить ему кнопку) рабочие листы текущей книги будут отсортированы либо по номерам, либо по алфавиту. Следует учитывать, что при включенной защите рабочей книги (Рецензирование → Изменения → Защитить книгу) выполнение данной операции невозможно.
Ниже приведен код макроса (листинг 2.9), при выполнении которого список отсортированных листов выводится на отдельный рабочий лист Сортировка.
Sub SortSheets2()
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
With ActiveWorkbook
' Cоздаем новый лист «Сортировка» (если он еще не создан)
On Error Resume Next
If .Sheets(«Сортировка») Is Nothing Then
.Sheets.Add.Name = «Сортировка»
End If
On Error GoTo 0
' Размещение данных на листе «Сортировка» (в столбец A)
intSheetCount = .Sheets.Count
For i = 1 To intSheetCount
.Sheets(«Сортировка»).Cells(i, 1) = .Sheets(i).Name
Next i
' Сортировка данных в ячейках листа «Сортировка» по содержимому _
столбца A
.Sheets(«Сортировка»).Range(«A1»).Sort _
Key1:=.Sheets(«Сортировка»).Range(«A1»), _
Order1:=xlAscending
' Заполнение массива имен отсортированными строками
ReDim astrSheetNames(1 To intSheetCount)
For i = 1 To intSheetCount
astrSheetNames(i) = .Sheets(«Сортировка»).Cells(i, 1)
Next i
' Перемещение листов
For i = 1 To intSheetCount
.Sheets(astrSheetNames(i)).Move .Sheets(i)
Next i
End With
' Переход на исходный рабочий лист
objActiveSheet.Activate
' Включаем обновление экрана
Application.ScreenUpdating = True
' Включение сочетания клавиш Ctrl+Pause Break
Application.EnableCancelKey = xlInterrupt
End Sub
