我明白你的问题——Dir()默认的排序逻辑坑到你了！它是按字符串字典序来返回文件的，而不是按文件名里的数字大小排序。比如PHOTOMICS10的第一个字符是1，在字典序里会排在PHOTOMICS2前面，因为字符1的ASCII码比2小，这就是你看到混乱顺序的原因。

要实现按数字递增顺序遍历，我们可以先把所有文件名收集到数组里，再对数组按数字部分排序，最后遍历排序后的数组插入图片。下面给你两种可行的方案：

方案1：兼容所有Excel版本的自定义排序 #

这种方法手动提取文件名中的数字，用冒泡排序对数组排序，适合所有Excel版本：

Sub InsertImagesInOrder()
    Dim MyFolder As String
    Dim fileNames() As String
    Dim count As Integer
    Dim i As Integer, j As Integer
    Dim tempName As String
    Dim num1 As Long, num2 As Long
    Dim ws1 As Worksheet
    
    ' 替换成你的图片文件夹路径
    MyFolder = "C:\YourImageDirectory"
    ' 指定要操作的工作表，可根据实际修改
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    
    ' 第一步：收集所有.jpg文件到数组中
    count = 0
    MyFile = Dir(MyFolder & "\*.jpg")
    Do While MyFile <> vbNullString
        count = count + 1
        ReDim Preserve fileNames(1 To count)
        fileNames(count) = MyFile
        MyFile = Dir
    Loop
    
    ' 第二步：按文件名中的数字部分排序数组
    For i = 1 To count - 1
        For j = i + 1 To count
            ' 提取文件名中的数字（去掉固定前缀"PHOTOMICS"）
            num1 = CLng(Replace(fileNames(i), "PHOTOMICS", ""))
            num2 = CLng(Replace(fileNames(j), "PHOTOMICS", ""))
            ' 按数字升序交换位置
            If num1 > num2 Then
                tempName = fileNames(i)
                fileNames(i) = fileNames(j)
                fileNames(j) = tempName
            End If
        Next j
    Next i
    
    ' 第三步：遍历排序后的数组插入图片
    Dim counter As Integer
    counter = 1
    For i = 1 To count
        incr = 43 * counter
        ws1.Cells(incr, 1).Activate
        ws1.Pictures.Insert(MyFolder & "\" & fileNames(i)).Select
        counter = counter + 1
    Next i
End Sub

方案2：Excel 365+ 简洁版（内置排序函数） #

如果你使用的是Excel 365或更高版本，可以直接用Excel内置的Sort函数，指定xlSortTextAsNumbers参数，让Excel自动识别字符串中的数字并按数值排序，代码更简洁：

Sub InsertImagesInOrder_365()
    Dim MyFolder As String
    Dim fileNames() As String
    Dim count As Integer
    Dim i As Integer
    Dim ws1 As Worksheet
    
    MyFolder = "C:\YourImageDirectory"
    Set ws1 = ThisWorkbook.Worksheets("Sheet1")
    
    ' 收集所有.jpg文件到数组
    count = 0
    MyFile = Dir(MyFolder & "\*.jpg")
    Do While MyFile <> vbNullString
        count = count + 1
        ReDim Preserve fileNames(1 To count)
        fileNames(count) = MyFile
        MyFile = Dir
    Loop
    
    ' 用Excel内置排序，按文本中的数字升序排列
    fileNames = Application.Sort(fileNames, , , , xlSortOnValues, xlAscending, , xlSortTextAsNumbers)
    
    ' 遍历插入图片
    Dim counter As Integer
    counter = 1
    For i = 1 To count
        incr = 43 * counter
        ws1.Cells(incr, 1).Activate
        ws1.Pictures.Insert(MyFolder & "\" & fileNames(i)).Select
        counter = counter + 1
    Next i
End Sub

关键说明： #

• 两种方案的核心都是先收集所有文件到数组，再排序，避免Dir()的默认排序问题
• 方案1的Replace方法适用于你固定的文件名前缀PHOTOMICS，如果前缀有变化，可以改用正则表达式提取数字
• 方案2的xlSortTextAsNumbers参数是Excel 365新增的，能自动识别字符串中的数字并按数值排序，省去手动提取数字的步骤

内容的提问来源于stack exchange，提问作者B. Moore