Microsoft Excel:

  Таблицы и VBA. Справочник.
  Вопросы и Ответы. Советы. Примеры.
Меню Заметки | VBA: Как на форме отобразить список XL файлов, вместе с иконками


Rambler's Top100


Counter CO.KZ

Если Вам необходимо получить список XL? файлов определённой папки, то в Windows, для этого существуют стандартные диалоговые окна, но если Вы пожелаете, например, поменять шрифт, изменить его размер, или заменить стандартные иконки на свои собственные, или же просто создать упрощённый вариант, то для создания имитации можно использовать ActiveX элемент управления Microsoft ListView Control. Собственно, всё нижеизложенное, это небольшой пример использования этого контрола, так что, если Вы хорошо знакомы с этим элементом управления, то в этой заметке Вы, вряд ли, найдёте что-то новое, остальные могут проделать следующее и получить, например, вот такой результат :



  • Откройте рабочую книгу, в которой Вы предполагаете создать пользовательскую форму
  • Перейдите в редактор VBA, для этого воспользуйтесь сочетанием клавиш ALT + F11, или в меню Сервис выберите пункт Макрос и команду Редактор Visual Basic
  • В меню Вставка/Insert выберите команду UserForm , или кликните правой кнопкой мышки и в появившемся контекстном меню выберите пункт Вставить/Insert и команду UserForm
  • Теперь, в меню Сервис/Tools выберите команду Дополнительные элементы/Additional Controls или подведите курсор мышки к панели инструментов Панель инструментов/Toolbox и кликните правой кнопкой мышки. В появившемся контекстном меню выберите команду Дополнительные элементы/Additional Controls

    Важно : вне зависимости от выбора, Панель инструментов обязательно должна отображаться на экране, иначе Вы просто не сможете воспользоваться вышеупомянутой командой. Поэтому, если панель не видна, то в меню Вид/View выберите команду Панель элементов/Toolbox или воспользуйтесь одноимённой кнопкой с панели Стандарт/Standard

  • После этого, в появившемся списке найдите и выберите следующие элементы управления и подтвердите свой выбор нажатием кнопки OK.

    Microsoft ListView Control, version ...
    Microsoft ImageList Control, version ...

    Важно : если на компьютере присутствует несколько различных версий, то Вам необходимо выбрать контролы одной и той же версии (т.е. если Вы решили работать с 6-й версией ListView, то и ImageList обязательно тоже должен быть 6-й версии, и наоборот), иначе возникнет ошибка (см. скриншот)



  • Кликните кнопку ListView и расположите этот элемент управления в нужном месте созданного диалогового окна.
  • При необходимости, скорректируйте месторасположение, а также высоту и ширину этого контрола. Осуществить это можно не только мышкой, но и воспользовавшись следующими свойствами Top, Left, Height, Width
  • Найдите свойство View и измените его значение на 2 - lvwList

    Комментарий : Обратите внимание на то, что допускается использование и других значений, так 0 - lvwIcon соответствует виду Крупные значки, 1 - lvwSmallIcon это Мелкие значки, а 3 - lvwReport , соответственно, Таблица, однако, это потребует некоторых изменений, за исключением мелких значков.





  • Затем, если Вы не хотите менять имена файлов вручную (как это происходит в проводнике), то установите значение свойства LabelEdit как 1 - lvwManual. Если же изменение имён файлов входит в планы, то значение свойства требуется оставить прежним, т.е. 0 - lvwAutomatic
  • Кликните небольшую кнопку, напротив свойства Font, и в появившемся окне установите нужный Шрифт, Начертание и Размер и подтвердите свой выбор нажатием кнопки Ok. Если имена файлов содержат кириллицу, то в выпадающем списке Набор символов: выберите Кириллица.

    Комментарий : Изменять значения этих свойств можно и программно, смотрите пример

  • Кликните кнопку ImageList и расположите этот элемент управления в любом месте диалогового окна. Обратите внимание на то, что этот "вспомогательный" контрол, предназначенный для хранения изображений / иконок, после вывода формы на экран, не будет отображаться на ней, а стало быть, нет особой необходимости прятать его от глаз пользователя.

    Теперь, загрузите в ImageList те иконки, которые должны ассоциироваться с определённым типом файлов, для этого :
  • Кликните небольшую кнопку, напротив свойства (Специальный)/(Custom), и в появившемся стандартном диалоговом окне выделите закладку General. После чего, выберите необходимый размер иконок, например, установите переключатель напротив 32 х 32, если же данные габариты Вас не устраивают, то выберите Custom и введите необходимые данные в текстовые поля Height: и Width:
  • Выделите закладку Images, кликните кнопку Insert Picture и с помощью стандартного диалогового окна, выберите свою иконку для файла и нажмите кнопку Открыть

    Совет : если в выпадающем списке Тип файлов: по умолчанию, установлен Bitmap and Icon Files (*.bmp, *.ico) и найти интересные иконки не получается, то выберите All Files (*.*) и повторите поиск, только учтите, что картинки, содержащие изображение "Бородинской панорамы" лучше не использовать.

  • Добавьте иконку для каждого из типов файлов, которые будут отображаться, на нашей форме, плюс ещё одна иконка, на тот случай, если в папке будет обнаружен файл с расширением, отличным от нижеперечисленных. В итоге, должно получиться 11 иконок.

    Тип файлаРасширение
    Лист Microsoft Excel.xls
    Шаблон.xlt
    Надстройка.xla
    Надстройка XLL.xll
    Рабочая область.xlw
    Макрос Microsoft Excel 4.0.xlm
    Microsoft Excel 5.0 DialogSheet.xld
    Диаграмма.xlc
    Модуль VBA.xlv
    Файл архива.xlk

    Комментарий : Разумеется, Вы вправе организовать перебор других типов файлов, или же искать только XLS файлы, в последнем случае, кстати, пример намного упрощается (смотрите вариант #3)
  • Private Sub UserForm_Initialize()
        iArrExtension = Array("xls", "xlt", "xla", _
        "xll", "xlw", "xlm", "xld", "xlc", "xlv", "xlk")
        
        iPath$ = ThisWorkbook.Path 'Укажите свою папку
        With Me.ListView1
             .SmallIcons = Me.ImageList1
             iFileName$ = Dir(iPath$ & "\*.xl?")
             Do Until iFileName$ = ""
                iSmallIconIndex = _
                Application.Match(Right(iFileName$, 3), iArrExtension, 0)
                If Not IsError(iSmallIconIndex) Then
                   .ListItems.Add , , iFileName$, , iSmallIconIndex
                Else
                   .ListItems.Add , , iFileName$, , 11
                End If
                iFileName$ = Dir
             Loop
             '.Sorted = True
        End With
        Me.Caption = iPath$
    End Sub
    Private Sub UserForm_Initialize()
        iArrExtension = Array("s", "t", "a", "l", "w", "m", "d", "c", "v", "k")
    
        iPath$ = ThisWorkbook.Path 'Укажите свою папку
        iFileName$ = Dir(iPath$ & "\*.xl?")
        If iFileName$ = "" Then
           Me.Caption = "Файлы не найдены ...": Exit Sub
        End If
        
        Me.ListView1.SmallIcons = Me.ImageList1
        With Me.ListView1.ListItems
             Do
                iSmallIconIndex = _
                Application.Match(Right(iFileName$, 1), iArrExtension, 0)
                If Not IsError(iSmallIconIndex) Then
                   .Add , , iFileName$, , iSmallIconIndex
                Else
                   .Add , , iFileName$, , 11
                End If
                iFileName$ = Dir
             Loop While iFileName$ <> ""
        End With
    End Sub
    Вариант только для файлов с расширением .XLS
    Private Sub UserForm_Initialize()
        ListView1.SmallIcons = ImageList1
    
        iPath$ = ThisWorkbook.Path 'Укажите свою папку
        iFileName$ = Dir(iPath$ & "\*.xls")
        Do Until iFileName$ = ""
           ListView1.ListItems.Add , , iFileName$, , 1
           iFileName$ = Dir
        Loop
        Caption = iPath$
    End Sub



    Пример можно скачать здесь


    Если же необходимо создать полноценную имитацию стандартного диалогового окна, где вместе с именами файлов, будут также отображаться и их иконки (причём, в отличии от первоначального варианта, эти иконки мы не можем предварительно загрузить в ImageList1, по причине их отсутствия), то в таком случае, нам придётся использовать функции WinAPI.

    Обратите внимание на то, что перед выполнение нижеопубликованного кода, одну иконку всё же необходимо загрузить в ImageList1, установив необходимые размеры. Это сделано для того, чтобы не связывать ListView1 и ImageList1 в цикле, где перебираются файлы указанной папки.





    'Идея использования функции OleCreatePictureIndirect
    'принадлежит автору материалов, изложенных в этой статье :
    'How To Capture and Print the Screen, a Form, or Any Window
    'http://support.microsoft.com/kb/161299/en-us
    
    Private Type PicBmp
        Size As Long
        Type As Long
        hBmp As Long
        hPal As Long
        Reserved As Long
    End Type
             
    Private Type GUID
        Data1 As Long
        Data2 As Integer
        Data3 As Integer
        Data4(7) As Byte
    End Type
            
    Private Declare Function OleCreatePictureIndirect _
            Lib "olepro32.dll" ( _
            PicDesc As PicBmp, _
            RefIID As GUID, _
            ByVal fPictureOwnsHandle As Long, _
            IPic As stdole.StdPicture) As Long
            
    Private Declare Function ExtractAssociatedIcon _
            Lib "shell32.dll" Alias "ExtractAssociatedIconA" ( _
            ByVal hInstance As Long, _
            ByVal lpIconPath As String, _
            lpIcon As Long) As Long
    
    Private Function createPicOfIcon(FileName$) As stdole.StdPicture
       Dim hIcon As Long, Pic As PicBmp
       Dim IID_IDispatch As GUID
       'Dim IPic As IPicture
       
       hIcon = ExtractAssociatedIcon(0&, FileName, 0&)
    
       With Pic
            .Size = Len(Pic)
            .Type = 3
            .hBmp = hIcon
       End With
       
       With IID_IDispatch
            .Data1 = &H20400
            .Data4(0) = &HC0
            .Data4(7) = &H46
       End With
       
       OleCreatePictureIndirect Pic, IID_IDispatch, 0, createPicOfIcon 'IPic
       'Set createPicOfIcon = IPic
    End Function
    
    Private Sub UserForm_Initialize()
        Dim iPath$, iFileName$
        Dim iPicIcon As stdole.StdPicture
        
        ListView1.View = lvwList 'можно установить вручную
        ListView1.SmallIcons = ImageList1
        'ListView1.Icons = ImageList1
       
        iPath = Application.Path & "\"
        iFileName = Dir(iPath): Caption = iPath
        
        Do Until iFileName = ""
           Set iPicIcon = createPicOfIcon(iPath & iFileName)
            
           ImageList1.ListImages.Add , iFileName, iPicIcon
           ListView1.ListItems.Add , , iFileName, , iFileName
           
           iFileName = Dir
        Loop
    End Sub



    Второй пример можно скачать здесь


    Автор : Климов Павел Юрьевич
    © 2004-2016 Климов П.Ю. Все права защищены. WebDesign & Error's Klimoff