Question

我正在尝试将几张图片插入excel电子表格，并将其另存为PDF。我已经能够弄清楚如何对图片进行间隔并遍历文件夹中的所有图片，但是似乎无法弄清楚如何按顺序遍历图片。

我发现我可以使用Dir遍历特定文件夹中的.jpg文件，如问题Loop through files in a folder using VBA?和问题macro - open all files in a folder所示。它产生了奇迹，但是我需要依次遍历图片。图片标记为“ PHOTOMICS0”，并且最终编号增加。

这就是我的工作。

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。重复时，它遵循相同的顺序。如何按数字顺序递增这些值？

Answer 1

由于cybernetic.nomad和Siddharth Rout的建议，我得以解决此问题。

我从这些帖子中使用了一些功能和代码行：

How to find numbers from a string?

How to sort an array of strings containing numbers

以下是起作用的代码：

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

使用Dir（）依次遍历文件

1 个答案: