Выбор названия файлов в листбокс в процедуре

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор названия файлов в листбокс в процедуре (Макросы/Sub)

ant6729

Дата: Среда, 10.10.2018, 15:52 | Сообщение № 1

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Всем привет! Подскажите, пожалуйста, как сделать, чтобы при мультиселекте файлов они добавлялись в листбокс, а потом программно выбирались?

К сообщению приложен файл: 25.xlsm (21.0 Kb)

Ответить

Roman777

Дата: Среда, 10.10.2018, 16:25 | Сообщение № 2

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

ant6729, думаю, что при использовании Application.FileDialog это врят ли у Вас выйдет. Зато всегда можно поставить фильтр и попробовать отображать только те файлы, которые Вас интересуют.

Много чего не знаю!!!!

Ответить

ant6729

Дата: Среда, 10.10.2018, 16:59 | Сообщение № 3

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Вообще в идеале хочу понять как зайти в папку выбрать нужные файлы
Они втянулись бы как проставленные
А остальные подтянулись бы туда же как не проставленные

Ответить

Roman777

Дата: Среда, 10.10.2018, 17:12 | Сообщение № 4

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

ant6729, Как Вариант:
Всё так же пользуетесь FileDialog-ом. Выбираете необходимые файлики. Уже знаете путь до корневой выбранной папки. Пробегаем по папке с файлами (возможно с помощью ф-ии Dir) - получим массив файлов (возможно и папок). Этот массив фильтруем (избавляемся от ненужных элементов). Получаем общий список необходимых файлов. Сравниваем SelectedItem и исключаем их из найденного общего массива. Ну а далее - SelectedItem расставляет птички, а оставшиеся элементы массива - остальные элементы без проставленной птички.
Быстро, с ходу Ваш подход исправить не смогу сейчас. Но на мысль, мб навёл, надеюсь)

Много чего не знаю!!!!

Ответить

ant6729

Дата: Среда, 10.10.2018, 20:33 | Сообщение № 5

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

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

Но здесь затык.

Ответить

ant6729

Дата: Среда, 10.10.2018, 20:56 | Сообщение № 6

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

[vba]

Код

Option Explicit

Private Sub btnBrowse_Click()

    Call GetFilesList

End Sub

Sub GetFilesList()

    Dim strPath, x, fn_

    Dim fso As New FileSystemObject, fsoFolder As Folder, fsoFile As File
    Dim coll As New Collection, coll2 As New Collection

    Set coll = New Collection
    Set coll2 = New Collection

    strPath = "H:\Ìàñòåð îò÷åòîâ\Îò÷åò — êîïèÿ\"
    Set fsoFolder = fso.GetFolder(strPath)
    Me.lstFiles.Clear

    With Application.FileDialog(msoFileDialogFilePicker)
        .Show

        For Each fn_ In .SelectedItems
            Me.lstFiles.AddItem Dir(fn_)
            coll.Add Dir(fn_)
        Next

        For x = 0 To lstFiles.ListCount - 1
            If lstFiles.Selected(x) = False Then lstFiles.Selected(x) = True
        Next

        For Each fsoFile In fsoFolder.Files
            Me.lstFiles.AddItem fsoFile.Name
            coll2.Add fsoFile.Name
        Next

    End With

End Sub

[/vba]

Почти так, как надо, но дублирует вывод

Сообщение отредактировал ant6729 - Среда, 10.10.2018, 22:03

Ответить

RAN

Дата: Среда, 10.10.2018, 21:21 | Сообщение № 7

Группа: Друзья

Ранг: Экселист

Сообщений: 5660

Репутация: 1163 ±

Замечаний: 0% ±

2010

Как беее без блинов и FSO
[vba]

Код

Private Sub UserForm_Activate()
    With Application.FileDialog(msoFileDialogFilePicker)
        .Show
        For Each fn_ In .SelectedItems
            Me.lstFiles.AddItem Dir(fn_)
        Next
    End With
    For i = 0 To Me.lstFiles.ListCount - 1
        Me.lstFiles.Selected(i) = True
    Next
End Sub

[/vba]

Быть или не быть, вот в чем загвоздка!

Ответить

ant6729

Дата: Среда, 10.10.2018, 22:19 | Сообщение № 8

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Сообщение отредактировал ant6729 - Четверг, 11.10.2018, 00:04

Ответить

ant6729

Дата: Четверг, 11.10.2018, 00:03 | Сообщение № 9

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

[vba]

Код

Option Explicit

Private Sub btnBrowse_Click()

    Call GetFilesList

End Sub

Sub GetFilesList()

    Dim strPath, x, fn_, i, k

    Dim fso As New FileSystemObject, fsoFolder As Folder, fsoFile As File
    Dim coll As New Collection, coll2 As New Collection

    Set coll = New Collection
    Set coll2 = New Collection

    strPath = "H:\Ìàñòåð îò÷åòîâ\Îò÷åò — êîïèÿ\"
    Set fsoFolder = fso.GetFolder(strPath)
    Me.lstFiles.Clear

    With Application.FileDialog(msoFileDialogFilePicker)
        .Show

        For Each fn_ In .SelectedItems
            Me.lstFiles.AddItem Dir(fn_)
            coll.Add Dir(fn_)
        Next

        For x = 0 To lstFiles.ListCount - 1
            If lstFiles.Selected(x) = False Then lstFiles.Selected(x) = True
        Next

        For Each fsoFile In fsoFolder.Files
            coll2.Add fsoFile.Name
        Next fsoFile

For k = 1 To coll2.Count
For i = 1 To coll.Count

On Error Resume Next
Debug.Print coll2(k) & " " & coll(i)

If coll(i) <> coll2(k) Then Me.lstFiles.AddItem coll2(k)

Next i
Next k

End With

End Sub

[/vba]

Логики на одно i хватит на два и более выбранных документов нужно что-то другое

Ответить

ant6729

Дата: Четверг, 11.10.2018, 12:06 | Сообщение № 10

Группа: Проверенные

Ранг: Ветеран

Сообщений: 533

Репутация: 2 ±

Замечаний: 40% ±

Excel 2010

Да, я сделал это. Шчасцю нет предела. Ура.
Спасибо всем, кто не подсказал) Совершенно искренне говорю.
[vba]

Код

[code][code]
Option Explicit

Private Sub btnBrowse_Click()

    Call GetFilesList

End Sub

Sub GetFilesList()

    Dim strPath, x, fn_
    Dim fso As New FileSystemObject, fsoFolder As Folder, fsoFile As File
    Dim dict As Scripting.Dictionary

    Set dict = New Scripting.Dictionary
    strPath = "H:\ааа\Отчет\"
    Set fsoFolder = fso.GetFolder(strPath)

    Me.lstFiles.Clear

    With Application.FileDialog(msoFileDialogFilePicker)
        .Show

        For Each fn_ In .SelectedItems
            Me.lstFiles.AddItem Dir(fn_)
            dict.Add Dir(fn_), 0
        Next

        For x = 0 To lstFiles.ListCount - 1
            If lstFiles.Selected(x) = False Then lstFiles.Selected(x) = True
        Next

        For Each fsoFile In fsoFolder.Files

            With dict
                If Not .Exists(fsoFile.Name) Then Me.lstFiles.AddItem fsoFile.Name
            End With

        Next fsoFile

    End With

End Sub

[/code][/code][/vba]

Словари оказались богаче на методы...

Сообщение отредактировал ant6729 - Четверг, 11.10.2018, 12:14

Ответить

Roman777

Дата: Четверг, 11.10.2018, 12:15 | Сообщение № 11

Группа: Проверенные

Ранг: Ветеран

Сообщений: 980

Репутация: 127 ±

Замечаний: 0% ±

Excel 2007, Excel 2013

ant6729, я бы тоже словарями делал))), не понимаю, зачем Вы 2 раза гоняете цикл?
[vba]

Код

        For Each fn_ In .SelectedItems
            Me.lstFiles.AddItem Dir(fn_)
            dict.Add Dir(fn_), 0
        Next

        For x = 0 To lstFiles.ListCount - 1
            If lstFiles.Selected(x) = False Then lstFiles.Selected(x) = True
        Next

[/vba]
если можно сразу:

[vba]

Код

        For Each fn_ In .SelectedItems
            Me.lstFiles.AddItem Dir(fn_)
            dict.Add Dir(fn_), 0
            Me.lstFiles.Selected(Me.lstFiles.ListCount - 1) = True
        Next

[/vba]

Много чего не знаю!!!!

Сообщение отредактировал Roman777 - Четверг, 11.10.2018, 12:18

Ответить

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Выбор названия файлов в листбокс в процедуре (Макросы/Sub)

Страница 1 из 1
1