用VBA代码来进行图片更换而无需插入这些图片 (vba添加图片)

Excel2119

单机【J4】单元格，在右下角出现的下拉菜单中选择图片名称，此时，左侧的图片更换为指定图片名的图片。此功能的VBA代码如下：

1. '用VBA代码来进行图片更换而无需插入这些图片 (vba添加图片)
   
2. 
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4.    
   
5.     If Target.Address = "$J$4" Then
   
6.         
   
7.         Dim Pic As Object, PicPathAndName As String, PicFolder As String
   
8.         
   
9.         Dim PicT As Integer, PicL As Integer, PicH As Integer, PicW As Integer
   
10.         
    
11.         PicFolder = "图片文件夹" '图片文件夹名称
    
12.         
    
13.         PicPathAndName = ThisWorkbook.Path & "" & PicFolder & "" & Range("J4") & ".png" '所选图片路径
    
14.         
    
15.         Set Pic = ActiveSheet.Shapes("图片 1")
    
16.         
    
17.         With Pic '原图片的位置和大小
    
18.         
    
19.         PicT = .Top
    
20.         
    
21.         PicL = .Left
    
22.         
    
23.         PicH = .Height
    
24.         
    
25.         PicW = .Width
    
26.         
    
27.         End With
    
28.         
    
29.         Pic.Delete '删除原图片
    
30.         
    
31.         Set Pic = ActiveSheet.Shapes.AddPicture(Filename:=PicPathAndName, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=PicL, Top:=PicT, Width:=PicW, Height:=PicH) '插入所选图片
    
32.         
    
33.         Pic.Name = "图片 1" '设置图片名称
    
34.         
    
35.     End If
    
36.    
    
37.     Set Pic = Nothing
    
38.    
    
39. End Sub

复制代码

附件： 【测试成功】用VBA代码来进行图片更换而无需插入这些图片 (vba添加图片).rar (418.37 KB, 下载次数: 42)

2023-3-10 11:00 上传

点击文件名下载附件
未加密

顺便给我点点赞，留点文字呗

踏破拖鞋

感谢分享，提供了计算思路  学习下

踏破拖鞋

图片类型锁定了PNG,我改为其他的测试后 ，再改回来就出错了