根据单元格内容插入图片（图片根据单元格内容改变）

自由！自在

根据单元格内容插入图片（图片根据单元格内容改变）我自己堆砌了一个在其中一个文件中能运行，复制到其他地方就不行了，那个大佬能帮忙检查一下

1. 
   
2. 
   
3. Private Sub Worksheet_Change(ByVal Target As Range)
   
4. On Error Resume Next
   
5. Application.ScreenUpdating = False
   
6. If Target.Address <> "$AB$16" Or Len([AB16]) = 0 Then Exit Sub
   
7. ActiveSheet.DrawingObjects.Delete
   
8. Path = Path & "D:\autoExcel\input"
   
9. s = [AB16].Value
   
10. ActiveSheet.Pictures.Insert(Path & s & "all.jpg").Select
    
11. With Selection
    
12.     .ShapeRange.LockAspectRatio = msoFalse
    
13.     .Top = [b5].Top + 1
    
14.     .Left = [b5].Left + 1
    
15.     .Height = [b5].MergeArea.Height + 164
    
16.     .Width = [b5].MergeArea.Width * 1.04
    
17. End With
    
18. 
    
19. With Selection.ShapeRange
    
20.   
    
21.    '裁剪
    
22.     .PictureFormat.CropTop = 0  '下移裁剪
    
23.     .PictureFormat.CropLeft = 0 '右移裁剪
    
24.     .PictureFormat.CropBottom = 167 '上移裁剪
    
25.     .PictureFormat.CropRight = 0 '左移裁剪
    
26. 
    
27.    End With
    
28. 
    
29. ActiveSheet.Pictures.Insert(Path & s & "all.jpg").Select
    
30. With Selection
    
31.     .ShapeRange.LockAspectRatio = msoFalse
    
32.     .Top = [U20].Top - 352
    
33.     .Left = [U5].Left + 1
    
34.     .Height = [U5].MergeArea.Height + 165
    
35.     .Width = [U5].MergeArea.Width * 1.04
    
36. End With
    
37. 
    
38. With Selection.ShapeRange
    
39.   
    
40.    '裁剪
    
41.     .PictureFormat.CropTop = 167  '下移裁剪
    
42.     .PictureFormat.CropLeft = 0 '右移裁剪
    
43.     .PictureFormat.CropBottom = 0 '上移裁剪
    
44.     .PictureFormat.CropRight = 0 '左移裁剪
    
45.     .IncrementLeft 0  '相对图片初始位置水平移动正数向右，负数向左
    
46.     .IncrementTop -120 '相对图片初始位置垂直移动正数向下，负数向上
    
47.    End With
    
48.    ActiveSheet.Pictures.Insert(Path & s & ".jpg").Select
    
49. With Selection
    
50.     .ShapeRange.LockAspectRatio = msoFalse
    
51.     .Top = [BH5].Top + 1
    
52.     .Left = [BH5].Left + 1
    
53.     .Height = [BH5].MergeArea.Height - 1
    
54.     .Width = [BH5].MergeArea.Width - 1
    
55. End With
    
56. 
    
57. With Selection.ShapeRange
    
58.   
    
59.    '裁剪
    
60.     .PictureFormat.CropTop = 0  '下移裁剪
    
61.     .PictureFormat.CropLeft = 0 '右移裁剪
    
62.     .PictureFormat.CropBottom = 0 '上移裁剪
    
63.     .PictureFormat.CropRight = 0 '左移裁剪
    
64.     .IncrementLeft 0  '相对图片初始位置水平移动正数向右，负数向左
    
65.     .IncrementTop 1  '相对图片初始位置垂直移动正数向下，负数向上
    
66.    End With
    
67. 
    
68. Application.ScreenUpdating = True
    
69. End Sub
    

复制代码

杨建营

地址好像不能这么写吧。
这个地址少“\”。
其中的all 是不是应该用*代替。

半百

自由！自在

杨建营 发表于 2023-4-6 09:29
地址好像不能这么写吧。
这个地址少“\”。
其中的all 是不是应该用*代替。

一个工作簿有两个表，我设置这个插入照片是在表2的，但是照片插入之后到表1了，代码我是写在表2 的，这是什么原因？

杨建营

自由！自在 发表于 2023-4-10 09:24
一个工作簿有两个表，我设置这个插入照片是在表2的，但是照片插入之后到表1了，代码我是写在表2 的，这是 ...

可能是你没有指定放在那个工作表，而是放在激活的工作表。运行宏时表1是激活的，因此需要指定放图片的工作表。