![](https://iknow-base.cdn.bcebos.com/lxb/notice.png)
1个回答
展开全部
Sub 自动导入图片()
Dim shp As Shape
Dim r As Range
Dim j As Integer '图片导入单元格
Dim k As Integer '图片序列号
Dim s As String '图片名称
Dim PicPath As String '图片所在目录
k = 1 '图片序列号初始编码
Set r = Sheet1.Range("A6000").End(xlUp)
s = InputBox("输入图片名称:" & vbNewLine & "注:不包含其序列号", "提示")
For j = 1 To r.Row '编号指定位置
j = i
PicPath = ThisWorkbook.Path & "\" & s & k & ".jpg"
If Dir(PicPath) <> "" Then
Set shp = Sheet1.Shapes.AddPicture(PicPath, False, True, 0, 0, -1, -1)
shp.Left = Range("B" & j).Left + 20
shp.Top = Range("B" & j).Top + 10
End If
k = k + 1
Next
Set r = Nothing
Set shp = Nothing
End Sub
Dim shp As Shape
Dim r As Range
Dim j As Integer '图片导入单元格
Dim k As Integer '图片序列号
Dim s As String '图片名称
Dim PicPath As String '图片所在目录
k = 1 '图片序列号初始编码
Set r = Sheet1.Range("A6000").End(xlUp)
s = InputBox("输入图片名称:" & vbNewLine & "注:不包含其序列号", "提示")
For j = 1 To r.Row '编号指定位置
j = i
PicPath = ThisWorkbook.Path & "\" & s & k & ".jpg"
If Dir(PicPath) <> "" Then
Set shp = Sheet1.Shapes.AddPicture(PicPath, False, True, 0, 0, -1, -1)
shp.Left = Range("B" & j).Left + 20
shp.Top = Range("B" & j).Top + 10
End If
k = k + 1
Next
Set r = Nothing
Set shp = Nothing
End Sub
追问
是否直接运行宏就可以?
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询