求助，VBA插入图片 - 编程论坛

东海ECS2023-04-27 19:22

可以通过将原代码中的 rng 变量修改为 a233:q237 的范围来实现在 a233:q237 中插入相应的图片。修改后的代码如下：

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range, fp$, shnm$, nm$, shp As Shape Dim tp, lf, wd '将 rng 变量修改为 a233:q237 的范围 Set rng = [a233:q237] If Target.Count > 1 Then Exit Sub If Target = "" Then Exit Sub If Target.Address <> "$AJ$35" Then Exit Sub fp = ThisWorkbook.Path & "\图片" nm = fp & "" & Target.Value & ".bmp" For Each shp In ActiveSheet.Shapes If shp.Type = msoAutoShape Then shp.Delete End If Next nn = Dir(nm) If nn <> "" Then With rng ML = .Left MT = .Top MW = .Width MH = .Height ActiveSheet.Shapes.AddShape(msoShapeRectangle, ML, MT, MW, MH).Select Selection.ShapeRange.Fill.UserPicture nm End With End If Target.Select End Sub

注意，修改后代码中的 rng 变量仅影响图片位置和大小，图片文件名仍是从单元格 AJ35 中获取，所以需要确保在单元格 AJ35 中输入的文件名与图片文件名一致。如果需要从其他单元格中获取文件名，可以对代码进行相应的修改。

阳光上的桥2023-04-28 08:49

修改后的程序代码如下，说明见注释：

程序代码：

Option Explicit '这个是好东西，建议都整起

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range, fp$, shnm$, nm$, shp As Shape
    Dim tp, lf, wd
    If Target.Count > 1 Then Exit Sub
    If Target = "" Then Exit Sub
    Select Case Target.Address
        Case "$AJ$35": Set rng = [g48:w62]  'AJ35文件名插入的地方
        Case "$AJ$36": Set rng = [a233:q237] 'AJ36文件名插入的地方，可以依葫芦画瓢自行添加更多的行
        Case Else: Exit Sub
    End Select
    fp = ThisWorkbook.Path & "\图片\"
    nm = fp & "\" & Target.Value & ".bmp"
    For Each shp In ActiveSheet.Shapes
        If shp.Type = msoAutoShape Then
            If shp.Left = rng.Left And shp.Top = rng.Top Then shp.Delete '这里很关键，只删除rng那个图，不能全删
        End If
    Next
    If Dir(nm) <> "" Then
        With rng
            ActiveSheet.Shapes.AddShape(msoShapeRectangle, .Left, .Top, .Width, .Height).Select
            Selection.ShapeRange.Fill.UserPicture nm
        End With
    End If
    Target.Select
End Sub