如何用VBA将网络共享驱动器图片批量插入Excel并支持覆盖调整大小

实现功能 #

• 批量读取指定单元格范围的图片共享路径
• 每张图片自动插入到对应行的目标单元格位置
• 支持统一设置图片最大尺寸，自动锁定纵横比避免变形
• 运行时自动清除原有插入的图片，实现内容覆盖

优化后完整代码 #

Sub 批量插入图片()
    ' 声明变量
    Dim 图片路径 As String
    Dim 插入图片 As Picture
    Dim 路径单元格范围 As Range
    Dim 单个路径单元格 As Range
    Dim 目标插入区域 As Range
    Dim 统一最大宽度 As Integer
    Dim 统一最大高度 As Integer
    
    ' --------------------------参数设置区，可自行修改--------------------------
    Set 路径单元格范围 = ActiveSheet.Range("A2:A28") ' 存放图片URL的单元格范围
    Set 目标插入区域 = ActiveSheet.Range("B2:B28") ' 图片要插入的对应单元格范围
    统一最大宽度 = 720 ' 图片统一最大宽度
    统一最大高度 = 330 ' 图片统一最大高度
    ' ------------------------------------------------------------------------
    
    ' 清除目标区域内原有图片，实现覆盖效果
    Dim shp As Shape
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoPicture Then
            If Not Intersect(shp.TopLeftCell, 目标插入区域) Is Nothing Then
                shp.Delete
            End If
        End If
    Next shp
    
    ' 循环遍历每个路径插入图片
    For Each 单个路径单元格 In 路径单元格范围
        图片路径 = 单个路径单元格.Value
        If 图片路径 <> "" Then
            On Error Resume Next ' 跳过路径不存在的错误
            Set 插入图片 = ActiveSheet.Pictures.Insert(图片路径)
            On Error GoTo 0
            
            If Not 插入图片 Is Nothing Then
                ' 设置图片位置和尺寸
                With 插入图片
                    .ShapeRange.LockAspectRatio = msoTrue ' 锁定纵横比
                    ' 先按宽度缩放，超过最大高度则按高度缩放
                    .Width = 统一最大宽度
                    If .Height > 统一最大高度 Then
                        .Height = 统一最大高度
                    End If
                    ' 对齐到对应行的目标单元格左上角
                    .Top = 目标插入区域.Cells(单个路径单元格.Row - 路径单元格范围.Row + 1, 1).Top
                    .Left = 目标插入区域.Cells(单个路径单元格.Row - 路径单元格范围.Row + 1, 1).Left
                    .Placement = xlMoveAndSize ' 设置图片随单元格移动调整大小，可根据需求修改
                End With
                Set 插入图片 = Nothing
            End If
        End If
    Next 单个路径单元格
End Sub

使用说明 #

• 脚本中参数设置区的范围、宽高数值可根据实际需求修改
• 若需要直接清空整个工作表的所有图片，可替换清除原有图片的代码段为ActiveSheet.Pictures.Delete
• 共享路径需确保当前设备有访问权限，图片格式需为Excel支持的常规图片格式

内容的提问来源于stack exchange，提问作者manima1