[已解决]EXCEL图片调用问题

A微微笑

zjdh 发表于 2016-11-20 16:29

大神，我刚下载了，不行哦，不会自动更新的{:12:}，还有一个问题，自动更新的图片能不能帮我改一下，我只是需要达到，长宽不要超那边框，但是原图的比例能帮我设置不要变吗？，因为我有些图片不是按这个设置长宽的比例存的，这种编号的图片更新出来的图片是变形的{:09:}，不胜感激，谢谢

叫我赵日天

彩图标签.rar (140.86 KB, 下载次数: 21)

2016-11-20 18:10 上传

点击文件名下载附件

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim picPath$, picTemp As Picture
   
3.    
   
4.     If InStr(Cells(Target.Row, Target.Column - 1), "ITEM") > 0 Then
   
5.             Target.Select
   
6.             picPath = ThisWorkbook.Path & "\产品图片" & Target.Value & ".jpg"  '定义插入图片的地址
   
7.             If Dir(picPath) = "" Then GoTo 10
   
8.             For Each shp In ActiveSheet.Shapes
   
9.             
   
10.     If shp.TopLeftCell.Address = Cells(Target.Row, Target.Column + 1).Address Then
    
11.         shp.Delete
    
12.     End If
    
13. Next
    
14. 
    
15.             Set picTemp = ActiveSheet.Pictures.Insert(picPath)    '插入图片
    
16.             picTemp.Placement = xlMoveAndSize    '设置图片可以随单元格的变动而改变大小和位置
    
17.             With picTemp.ShapeRange
    
18.                 .Top = Selection.Top + 10
    
19.                 .Left = Selection.Offset(0, 1).Left
    
20.                 .LockAspectRatio = msoFalse
    
21.                 .Height = Selection.Height * 4
    
22.                 .Width = Selection.Offset(0, 1).Width
    
23.             End With
    
24. End If
    
25. 10
    
26. End Sub

复制代码

zjdh

A微微笑 发表于 2016-11-20 16:42
大神，我刚下载了，不行哦，不会自动更新的，还有一个问题，自动更新的图片能不能帮我改一下，我只 ...

不可能不更新图片的，我这都测试过的，除非你禁用了宏。你的图片大大小小，可能会不太美观。

修改后的附件：
彩图标签3.rar (238.07 KB, 下载次数: 40)

2016-11-20 21:39 上传

点击文件名下载附件

A微微笑

叫我赵日天 发表于 2016-11-20 18:10

大神，能帮我再改进一下这个表吗？？谢谢

A微微笑

等大神来

A微微笑

zjdh 发表于 2016-11-20 21:39
不可能不更新图片的，我这都测试过的，除非你禁用了宏。你的图片大大小小，可能会不太美观。

修改后的 ...

谢谢大神，，我说的问题都解决了，不过弱弱的问句还有一些小问题：1、刚我试着调整插入一些行或列，就有问题了，能帮我再改进一下吗？？使可以随便插入行或列，宏都能正常运行！

2、类似这种图片， 能帮我默认调出来的图片是在旁边那个框居中显示吗？？而不是这样在最顶上，谢谢

zjdh

彩图标签4.rar (238.64 KB, 下载次数: 26)

2016-11-22 20:57 上传

点击文件名下载附件

叫我赵日天

彩图标签.rar (143.06 KB, 下载次数: 33)

2016-11-22 20:58 上传

点击文件名下载附件

1. Private Sub Worksheet_Change(ByVal Target As Range)
   
2. Dim picPath$, picTemp As Picture
   
3.    
   
4.     If InStr(Cells(Target.Row, Target.Column - 1), "ITEM") > 0 Then
   
5.             Target.Select
   
6.             picPath = ThisWorkbook.Path & "\产品图片" & Target.Value & ".jpg"  '定义插入图片的地址
   
7.            
   
8.             For Each shp In ActiveSheet.Shapes
   
9.             
   
10.     If shp.TopLeftCell.Address = Cells(Target.Row, Target.Column + 1).Address Then
    
11.         shp.Delete
    
12.     End If
    
13. Next
    
14. If Dir(picPath) = "" Then GoTo 0
    
15. 
    
16. 
    
17.             Set picTemp = ActiveSheet.Pictures.Insert(picPath)    '插入图片
    
18.             picTemp.Placement = xlMove    '设置图片可以随单元格的变动而改变大小和位置
    
19.             With picTemp.ShapeRange
    
20.                 .Top = Selection.Top + 10
    
21.                 .Left = Selection.Offset(0, 1).Left
    
22.                 .LockAspectRatio = msoFalse
    
23.                
    
24.                 '.Height = Selection.Height * 4
    
25.                 .Width = Selection.Offset(0, 1).Width
    
26.             End With
    
27. End If
    
28. 0
    
29. End Sub

复制代码