如何通过宏在Excel指定单元格批量导入图片？

完全可以通过VBA宏实现你要求的功能，以下是两种方案的代码：

方案1：严格按指定顺序导入到目标单元格 #

该宏会将选中的前8张图片依次导入到B2、D2、B4、D4、B6、D6、B8、D8单元格，图片会自动匹配单元格的位置和尺寸：

Sub ImportImagesInSpecifiedOrder()
    Dim fd As FileDialog
    Dim selectedFiles As Variant
    Dim imgPath As String
    Dim imgIndex As Integer
    ' 定义目标单元格顺序
    Dim targetRanges As Variant
    targetRanges = Array("B2", "D2", "B4", "D4", "B6", "D6", "B8", "D8")
    
    ' 创建文件选择对话框，允许多选图片
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "选择要导入的图片（最多8张）"
        .Filters.Clear
        .Filters.Add "图片文件", "*.jpg;*.jpeg;*.png;*.bmp"
        .AllowMultiSelect = True
        If .Show = -1 Then
            selectedFiles = .SelectedItems
            ' 遍历选中的文件，最多处理前8张
            For imgIndex = LBound(selectedFiles) To UBound(selectedFiles)
                If imgIndex > UBound(targetRanges) Then Exit For ' 超过指定单元格数量时停止
                imgPath = selectedFiles(imgIndex)
                ' 插入图片到目标单元格
                With ActiveSheet.Shapes.AddPicture( _
                    Filename:=imgPath, _
                    LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, _
                    Left:=ActiveSheet.Range(targetRanges(imgIndex - LBound(selectedFiles))).Left, _
                    Top:=ActiveSheet.Range(targetRanges(imgIndex - LBound(selectedFiles))).Top, _
                    Width:=ActiveSheet.Range(targetRanges(imgIndex - LBound(selectedFiles))).Width, _
                    Height:=ActiveSheet.Range(targetRanges(imgIndex - LBound(selectedFiles))).Height)
                    .Name = "Img_" & imgIndex
                End With
            Next imgIndex
            MsgBox "图片导入完成！共导入" & imgIndex & "张图片", vbInformation
        Else
            MsgBox "未选择任何文件", vbExclamation
        End If
    End With
    Set fd = Nothing
End Sub

方案2：导入到B列和D列（可灵活调整行位置） #

如果需要更灵活地导入到B、D列，可使用该宏，默认从第2行开始依次填充B、D列，若需要间隔行（如B2、D2、B4、D4...），只需修改代码中的行递增逻辑：

Sub ImportImagesToBandDColumns()
    Dim fd As FileDialog
    Dim selectedFiles As Variant
    Dim imgPath As String
    Dim imgIndex As Integer
    Dim rowNum As Integer
    Dim colOffset As Integer
    
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Title = "选择要导入的图片"
        .Filters.Clear
        .Filters.Add "图片文件", "*.jpg;*.jpeg;*.png;*.bmp"
        .AllowMultiSelect = True
        If .Show = -1 Then
            selectedFiles = .SelectedItems
            rowNum = 2 ' 起始行
            colOffset = 0 ' 0对应B列，1对应D列
            For imgIndex = LBound(selectedFiles) To UBound(selectedFiles)
                imgPath = selectedFiles(imgIndex)
                ' 确定目标列
                Dim targetCol As String
                targetCol = IIf(colOffset = 0, "B", "D")
                ' 插入图片并匹配单元格尺寸
                With ActiveSheet.Shapes.AddPicture( _
                    Filename:=imgPath, _
                    LinkToFile:=msoFalse, _
                    SaveWithDocument:=msoTrue, _
                    Left:=ActiveSheet.Range(targetCol & rowNum).Left, _
                    Top:=ActiveSheet.Range(targetCol & rowNum).Top, _
                    Width:=ActiveSheet.Range(targetCol & rowNum).Width, _
                    Height:=ActiveSheet.Range(targetCol & rowNum).Height)
                    .Name = "Img_" & imgIndex
                End With
                ' 切换列，满两列后换行
                colOffset = colOffset + 1
                If colOffset >= 2 Then
                    colOffset = 0
                    rowNum = rowNum + 1 ' 改为rowNum = rowNum + 2即可实现间隔行
                End If
            Next imgIndex
            MsgBox "图片导入完成！共导入" & imgIndex & "张图片", vbInformation
        Else
            MsgBox "未选择任何文件", vbExclamation
        End If
    End With
    Set fd = Nothing
End Sub

使用方法 #

1. 打开Excel，按下Alt + F11打开VBA编辑器
2. 右键点击当前工作簿，选择「插入」→「模块」
3. 将上述任意一段代码粘贴到模块中
4. 返回Excel，按下Alt + F8，选择对应的宏执行即可

内容的提问来源于stack exchange，提问作者Zoran Maćešić