Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/MS Visio: сортировка листов книги - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: _Boroda_, китин  
MS Visio: сортировка листов книги
Alex_ST Дата: Вторник, 20.12.2011, 16:26 | Сообщение № 1
Группа: Друзья
Ранг: Участник клуба
Сообщений: 3214
Репутация: 615 ±
Замечаний: 0% ±

2003
[vba]
Код
Sub ReOrder_Pages(doc As Visio.Document)
     Dim iPage As Visio.Page
     Dim Arr$(), jArr$, iArr$, i%, j%
     ReDim Arr(1 To doc.Pages.Count)

     For i = 1 To doc.Pages.Count   ' заполнить массив имён листов
        Arr(i) = doc.Pages(i).Name
     Next i

     For j = LBound(Arr) To UBound(Arr)   ' сортировать массив
        For i = UBound(Arr) To LBound(Arr) + 1 Step -1
           jArr = Arr(i - 1): iArr = Arr(i)
           If iArr < jArr Then Arr(i) = jArr: Arr(i - 1) = iArr
        Next i
     Next j

     For i = 1 To doc.Pages.Count   ' изменить индексы имён листов по массиву
        doc.Pages(Arr(i)).Index = i
     Next i
End Sub
[/vba]



С уважением,
Алексей
MS Excel 2003 - the best!!!


Сообщение отредактировал Alex_ST - Вторник, 20.12.2011, 16:36
 
Ответить
Сообщение[vba]
Код
Sub ReOrder_Pages(doc As Visio.Document)
     Dim iPage As Visio.Page
     Dim Arr$(), jArr$, iArr$, i%, j%
     ReDim Arr(1 To doc.Pages.Count)

     For i = 1 To doc.Pages.Count   ' заполнить массив имён листов
        Arr(i) = doc.Pages(i).Name
     Next i

     For j = LBound(Arr) To UBound(Arr)   ' сортировать массив
        For i = UBound(Arr) To LBound(Arr) + 1 Step -1
           jArr = Arr(i - 1): iArr = Arr(i)
           If iArr < jArr Then Arr(i) = jArr: Arr(i - 1) = iArr
        Next i
     Next j

     For i = 1 To doc.Pages.Count   ' изменить индексы имён листов по массиву
        doc.Pages(Arr(i)).Index = i
     Next i
End Sub
[/vba]

Автор - Alex_ST
Дата добавления - 20.12.2011 в 16:26
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!