Excel VBA создать выпадающий список

Question

Я пытаюсь написать какой-нибудь код, который создаст выпадающий список, содержащий все файлы с определенным расширением в папке. Исходный код здесь:

Dim FSOLibrary As Object
Dim FSOFolder As Object
Dim FSOFile As Object
Dim fp As String
Dim i As Integer    

fp = Environ("UserProfile") & "\OneDrive\Desktop\Test"

Set FSOLibrary = CreateObject("Scripting.FileSystemObject")
Set FSOFolder = FSOLibrary.GetFolder(fp)
Set FSOFile = FSOFolder.Files

i = 1

For Each FSOFile In FSOFile
    If FSOFile Like "*.txt*" Then
        'just put the name into column B for testing
        Range("B" & i).Value = FSOFile.Name
        i = i + 1
    End If    
Next FSOFile

Очевидно, мне нужно добавить часть кода для проверки данных, но я не уверен, как лучше ее построить. Количество файлов является динамическим.

Я думал о том, чтобы поместить все файлы, которые соответствуют требуемому типу расширения файла, в массив, а затем записать каждую запись массива в раздел проверки данных?

Я видел, что Dir () довольно часто используется, но я не до конца понимаю, поэтому решил использовать fso.

Answer 1

Использование диапазона Excel

Раскрывающийся список обычно состоит из 2 вещей:

• определение диапазона, который используется для списка значений
• запись этих значений в строку, разделенную запятой

Код, приведенный ниже, делает именно это:

• Сначала он переходит от строки 1 к строке endRow, до значений в этих строках. Они записываются в строку validationString, и после каждого значения ячейки добавляется запятая
• , последняя запятая бесполезна, поэтому она удаляется вместе с пробелом: validationString = Left(validationString, Len(validationString) - 2)
• validationString передается в свойство .Validation ячейки "A1".

---

Sub TestMe()

    Dim wks As Worksheet: Set wks = Worksheets(1)
    Dim endRow As Long: endRow = LastRow(wks.Name, 3)
    Dim validationString As String
    Dim i As Long

    For i = 1 To endRow
        validationString = validationString & wks.Cells(i, "C") & ", "
    Next i

    validationString = Left(validationString, Len(validationString) - 2)

    With Worksheets(1).Cells(1, "A").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:=validationString
    End With

End Sub


Function LastRow(wsName As String, Optional columnToCheck As Long = 1) As Long
    Dim ws As Worksheet
    Set ws = Worksheets(wsName)
    LastRow = ws.Cells(ws.Rows.Count, columnToCheck).End(xlUp).Row
End Function

---

Без записи в диапазон

Здесь «хитрость» заключается в том, чтобы взять данные из цикла и записать их в список, циклически перебирая fsoFolder.Files:

Sub TestMe()

    Dim filePath As String
    filePath = Environ("UserProfile") & "\Desktop\QA"
    Dim fsoLibrary As Object: Set fsoLibrary = CreateObject("Scripting.FileSystemObject")
    Dim fsoFolder As Object: Set fsoFolder = fsoLibrary.GetFolder(filePath)
    Dim fsoFile As Object

    Dim validationString As String
    For Each fsoFile In fsoFolder.Files
        If fsoFile Like "*.txt*" Then
            validationString = validationString & fsoFile.Name & ", "
        End If
    Next fsoFile

    validationString = Left(validationString, Len(validationString) - 2)

    With Worksheets(1).Cells(1, "A").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:=validationString
    End With

End Sub