Excel VBA宏需求：多文件夹按年份顺序查找并插入对应图片

需求说明 #

我在Excel表格中填写了文章编号，希望通过宏在编号相邻的单元格中插入对应文章的图片。要求按指定起始年份往更早年份的顺序，在“Ano 2024、Ano 2023……”这类年份文件夹中查找图片，若当前年份文件夹无对应图片则继续查找上一年的。目前编写的宏仅能查找单个文件夹，需要通过循环实现多文件夹查找。

改进后的代码 #

下面是修改后的VBA代码，核心加入年份循环逻辑，从指定起始年份逐年递减查找，直到找到图片或遍历完更早年份：

Sub Insert_fotos()
    Dim str_FolderPath As String
    Dim rng_Current As Range
    Dim str_StartYear As String
    Dim int_Year As Integer
    Dim str_ImagePath As String
    Dim bln_Found As Boolean
    
    ' 基础文件夹路径
    str_FolderPath = "K:\ADMINISTRACION_COMPRAS\06_Admon_NF\02.Contratos"
    ' 获取起始年份输入
    str_StartYear = InputBox("输入查找的起始年份", "起始年份", "2024")
    
    ' 删除工作表中所有现有图片
    On Error Resume Next
    For Each Shape In ActiveSheet.Shapes
        Shape.Delete
    Next Shape
    On Error GoTo 0
    
    ' 从E4开始处理，对应左边D列的编号
    Set rng_Current = ActiveSheet.Range("E4")
    
    ' 遍历所有有编号的行
    Do Until rng_Current.Offset(0, -1).Value = ""
        bln_Found = False
        ' 从起始年份逐年递减查找（2000为最早年份，可自行调整）
        For int_Year = CInt(str_StartYear) To 2000 Step -1
            str_ImagePath = str_FolderPath & "\Ano " & int_Year & "\" & rng_Current.Offset(0, -1).Value & " Foto " & rng_Current.Offset(0, -1).Value & ".jpg"
            
            ' 检查文件是否存在
            If Dir(str_ImagePath) <> "" Then
                ' 插入图片到当前单元格
                ActiveSheet.Pictures.Insert(str_ImagePath).Select
                ' 调整图片大小适配单元格（可选）
                With Selection.ShapeRange
                    .LockAspectRatio = msoTrue
                    .Top = rng_Current.Top
                    .Left = rng_Current.Left
                    .Height = rng_Current.Height
                End With
                bln_Found = True
                Exit For ' 找到图片就跳出年份循环
            End If
        Next int_Year
        
        ' 可选：未找到图片时提示
        ' If Not bln_Found Then MsgBox "未找到编号" & rng_Current.Offset(0, -1).Value & "的图片"
        
        ' 移动到下一行
        Set rng_Current = rng_Current.Offset(1, 0)
    Loop
    
    ' 回到初始位置
    ActiveSheet.Range("B4").Select
End Sub

代码关键改进点 #

• 年份递减循环：从输入的起始年份开始，逐年向下查找（Step -1），直到找到图片或到达设定的最早年份（代码中为2000，可按需修改）。
• 文件存在校验：用Dir()函数判断图片路径有效性，避免因找不到文件触发错误。
• 优化单元格引用：用rng_Current变量替代Select操作，提升代码效率与稳定性。
• 可选图片适配：加入图片大小适配单元格的逻辑，可根据需求保留或删除。

使用步骤 #

1. 打开Excel，按Alt+F11打开VBA编辑器。
2. 插入模块，粘贴上述代码。
3. 返回Excel，运行宏Insert_fotos，输入起始年份后即可自动查找并插入图片。

内容的提问来源于stack exchange，提问作者Javier Puig Rovira