Перебирая файлы в порядке с Dir () - PullRequest
Новая
       24

Перебирая файлы в порядке с Dir ()

1 голос
/ 28 июня 2019

Я пытаюсь вставить несколько изображений в таблицу Excel и сохранить их в формате PDF. Мне удалось выяснить, как расположить картинки и перебрать все картинки в папке, но я не могу понять, как перебирать картинки по порядку.

Я обнаружил, что могу перебирать файлы .jpg в определенной папке, используя Dir, как показано в этом вопросе: Проходить по файлам в папке с использованием VBA? и этот вопрос macro - открыть все файлы в папке . Это творило чудеса, но мне нужно перебирать картинки по порядку. Снимки помечены «ФОТОМИКА0», и это окончательное число увеличивается.

Вот с чем я работаю. 

counter = 1
MyFile = Dir(MyFolder & "\*.jpg")
Do While MyFile <> vbNullString
    incr = 43 * counter
    Cells(incr, 1).Activate
    ws1.Pictures.Insert(MyFolder & "\" & MyFile).Select
    MyFile = Dir
    counter = counter + 1
Loop

До сих пор MyFile прошел путь от «PHOTOMICS0» до «PHOTOMICS4», 9, 10, 7, 2, 3, 8, 6, 5 и, наконец, 1. При повторении он следует в том же порядке. Как я могу увеличить их в числовом порядке?

1 Ответ

0 голосов
/ 29 июня 2019

Благодаря совету cybernetic.nomad и Siddharth Rout Мне удалось это исправить.

Я использовал некоторые функции и строки кодов из этих сообщений:

Как найти числа из строки?

Как отсортироватьмассив строк, содержащий числа

Вот код функции: 

counter = 0
MyFile = Dir(MyFolder & "\*.jpg")
Do While MyFile <> vbNullString
    ReDim Preserve PMArray(counter)
    PMArray(counter) = MyFile
    MyFile = Dir
    counter = counter + 1
Loop

Call BubbleSort(PMArray)

b = counter - 1
For j = 0 To b
    a = j + 1
    If i > 24 Then a = j + 2
    incr = 43 * a
    Cells(incr, 1).Activate
    ws1.Pictures.Insert(MyFolder & "\" & PMArray(j)).Select
Next j

Где BubbleSort и связанная с ней функция, используемая в BubbleSort: 

Sub BubbleSort(arr)
  Dim strTemp As String
  Dim i As Long
  Dim j As Long
  Dim lngMin As Long
  Dim lngMax As Long
  lngMin = LBound(arr)
  lngMax = UBound(arr)
  For i = lngMin To lngMax - 1
    For j = i + 1 To lngMax
      If onlyDigits(arr(i)) > onlyDigits(arr(j)) Then
        strTemp = arr(i)
        arr(i) = arr(j)
        arr(j) = strTemp
      End If
    Next j
  Next i
End Sub

Function onlyDigits(s) As Integer
    ' Variables needed (remember to use "option explicit").   '
    Dim retval As String    ' This is the return string.      '
    Dim retvalint As Integer
    Dim i As Integer        ' Counter for character position. '

    ' Initialise return string to empty                       '
    retval = ""

    ' For every character in input string, copy digits to     '
    '   return string.                                        '
    For i = 1 To Len(s)
        If Mid(s, i, 1) >= "0" And Mid(s, i, 1) <= "9" Then
            retval = retval + Mid(s, i, 1)
        End If
    Next

    ' Then return the return string.                          '
    retvalint = CInt(retval)
    onlyDigits = retvalint
End Function
...