|
Sub 批量添加图片()
On Error Resume Next '遇到错误代码,执行下一句
For Each shap In Sheet1.Shapes '遍历所有图形对象
If shap.Type <> 8 Then shap.Delete '如果图形对象类型不等于8,就删除它。这里类型8表示按钮
Next shap 'for循环结束语句
Set m = Sheet1.[d65536].End(3) '表sheet1的A列有数据最后一个单元格
For Each Rng In Range([d2], m) '遍历b2及以下有数据单元格
i = ThisWorkbook.Path & "\图片\" & Rng & ".jpg" '动态的图片位置
Set rngs = Cells(Rng.Row, 5) '动态的插入图片位置
Sheet1.Shapes.AddPicture i, True, True, rngs.Left + 2, rngs.Top + 2, rngs.Width - 3.5, rngs.Height - 3.5 '批量插入图片
Next Rng '循环结束语句
Call SetOnClick
End Sub
Private Sub SetOnClick()
Dim x
For Each x In ActiveSheet.Shapes
If x.Type = msoLinkedPicture Then x.OnAction = "onClick"
Next
End Sub |
评分
-
查看全部评分
|