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

Вход

Регистрация

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

 

= Мир MS Excel/Готовые решения

МЕНЮ САЙТА
  • 1
  • 2
  • 3

КАТЕГОРИИ РАЗДЕЛА

ОПРОСЫ
Какой версией Excel Вы пользуетесь?
Всего ответов: 40635
Главная » Готовые решения » VBA » Полезные приёмы

Список имен листов из закрытой книги
21.12.2016, 17:55
[ Файл-пример (20.2Kb) ]
Sub GetListOfSheets() 'список листов (и именованнных диапазонов) их закрытого файла
Dim fName$, i As Long, rc As Long, y
Dim sPrv As String, sConStr As String
Dim f$, arr()

With Application.FileDialog(msoFileDialogFilePicker)
 .Title = "Please select a file": .InitialFileName = ThisWorkbook.Path
 .Filters.Add "Excel", "*.xls;*.xlsx;*.xlsm", 1: .AllowMultiSelect = False
 If .Show = False Then Exit Sub: If .SelectedItems.Count = 0 Then Exit Sub
 fName = .SelectedItems(1)
End With

If Val(Application.Version) < 12 Then
 sPrv = "Microsoft.Jet.OLEDB.4.0": sConStr = "Data Source=" & fName & ";Extended Properties=Excel 8.0;"
Else
 sPrv = "Microsoft.ACE.OLEDB.12.0": sConStr = "Data Source=" & fName & ";Extended Properties=Excel 12.0;"
End If

With New ADODB.Connection
 .Provider = sPrv: .ConnectionString = sConStr: .CursorLocation = adUseClient: .Open
 With .OpenSchema(adSchemaTables)
 ' With .OpenSchema(adSchemaTables, Array(Empty, Empty, Empty, "Table"))' or so
 rc = .RecordCount
 ReDim arr(1 To rc + 1, 1 To 2)
 arr(1, 1) = "#Sheets": arr(1, 2) = fName
 For i = 1 To rc
 arr(i + 1, 1) = i: arr(i + 1, 2) = Replace(.Fields("TABLE_NAME").Value, "$", "")
 .MoveNext
 Next i
 .Close
 End With
 .Close
End With
Range("A1").CurrentRegion.ClearContents
Range("A1:B1").Resize(UBound(arr)).Value = arr()
End Sub
Добавил: nilem | | Теги: Именованные диапазоны, Список листов закрытой книги, Именованные диапазоны закрытой книг
Просмотров: 294 | Рейтинг: 0.0/0
Всего комментариев: 0
Добавлять комментарии могут только зарегистрированные пользователи.
[ Регистрация | Вход ]
Яндекс цитирования
© 2010-2017 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!