|
用Pictures.Insert 插入图片后 由于图片是链接导致其他电脑不能显示。
求大神帮忙该一下。使用Shape.AddPicture 或者其他方式解决
图片在G:\公司产品图集
目标 实现同样的功能。
1、根据A列名称 在图集找到相应的图片 插入到D列
2、插入之前先删除现有的照片。
3、插入图片不是链接。
附原有代码
Dim i, arr, str, typ, shp
On Error Resume Next '忽略运行中可能出现的错误
Application.ScreenUpdating = False '关闭工作表更新,提高运行速度
Set mysheet1 = ThisWorkbook.Worksheets("生产计划单") '定义Sheet1工作表
arr = Array(".jpg", ".jpeg", ".png", ".bmp", ".gif", ".tif") '图片格式集合
For Each shp In mysheet1.Shapes
If shp.Left > mysheet1.Columns("C").Left And shp.Left < mysheet1.Columns("F").Left Then
shp.Delete '如果是D-E列单元格里边的图片,则删除
End If
Next
For i = 2 To 1000 '从第2行到1000行
If mysheet1.Cells(i, 2) <> "" Then '如果B列对应的单元格不为空白,则执行
For Each typ In arr '执行图片格式组里面的每一个尝试
str = "G:\公司产品图集\" & mysheet1.Cells(i, 2).Value & typ '图片路径
If Dir(str) <> "" Then '如果图片存在,则执行
mysheet1.Pictures.Insert(str).Select '插入图片并选择
With Selection.ShapeRange
.LockAspectRatio = msoFalse '不锁定图片的比例
.Height = mysheet1.Cells(i, 4).Height - 4 '图片的高度设为单元格高度-4
.Width = mysheet1.Cells(i, 4).Width - 4 '图片的宽度设为单元格高度-4
.Top = mysheet1.Cells(i, 4).Top + 2 '图片的位置为D列对应单元格到顶部的距离+2
.Left = mysheet1.Cells(i, 4).Left + 2 '图片的位置为D列对应单元格到左侧的距离+2
End With
mysheet1.Cells(i, 4) = "" '清空D列对应单元格的内容
Exit For '导入图片后,退出For循环
Else
End If
Next
End If
Next
mysheet1.Cells(i + 1, 4).Select
Application.ScreenUpdating = True '恢复更新显示
End Sub
|
|