需求:
在Excel中插入图片,文件名在某一行或列,将对应目录下的图片文件插入至下一行。
代码: 建立一个宏,将代码复制到宏里,将原来的方法全部覆盖掉
Sub 清空图片()
在Excel中插入图片,文件名在某一行或列,将对应目录下的图片文件插入至下一行。
代码: 建立一个宏,将代码复制到宏里,将原来的方法全部覆盖掉
Sub 清空图片()
'删除当前sheet上所有的图片文件
For Each Shape In ActiveSheet.Shapes
Shape.Delete
Next
For Each Shape In ActiveSheet.Shapes
Shape.Delete
Next
End Sub
Sub 插入图片()
FilePath = "C:UsersAdministratorPictures" '图片文件路径
Fill = 0 '插入方式:1:按列插入图片(横向) , 0 按行插入图片(纵向)
Fill = 0 '插入方式:1:按列插入图片(横向) , 0 按行插入图片(纵向)
Row = 3 '款号所在的行数
col = 2 '款号所在的列数
Location = 1 ' 1: 在右边或下面 , -1 : 在左边或上面
col = 2 '款号所在的列数
Location = 1 ' 1: 在右边或下面 , -1 : 在左边或上面
Do
'根据第一行的图片文件名,将图片插入在第二行内,并调整图片的高与宽
With Cells(Row + IIf(Fill = 1, Location, 0), col + IIf(Fill = 0, Location, 0))
.Select
L = .Left
T = .Top
W = .Width
H = .Height
Filename = Cells(Row, col).Text & ".jpg" '生成文件名
If Filename = ".jpg" Then '如果1行为空,表示结束
Exit Do
End If
If Dir(FilePath & Filename) <> "" Then '检查文件存在
'插入图片
ActiveSheet.Shapes.AddShape(1, L, T, W, H).Fill.UserPicture (FilePath & Filename)
'根据第一行的图片文件名,将图片插入在第二行内,并调整图片的高与宽
With Cells(Row + IIf(Fill = 1, Location, 0), col + IIf(Fill = 0, Location, 0))
.Select
L = .Left
T = .Top
W = .Width
H = .Height
Filename = Cells(Row, col).Text & ".jpg" '生成文件名
If Filename = ".jpg" Then '如果1行为空,表示结束
Exit Do
End If
If Dir(FilePath & Filename) <> "" Then '检查文件存在
'插入图片
ActiveSheet.Shapes.AddShape(1, L, T, W, H).Fill.UserPicture (FilePath & Filename)
End If
End With
If Fill = 1 Then
col = col + 1
Else
Row = Row + 1
End If
Loop
Cells(1, 1).Select '回到A1单元格
End Sub
End With
If Fill = 1 Then
col = col + 1
Else
Row = Row + 1
End If
Loop
Cells(1, 1).Select '回到A1单元格
End Sub
' Mark:
'旧方法,仅插入链接
' ActiveSheet.Pictures.Insert(FilePath & Filename).S elect '插入图片
' Selection.ShapeRange.LockAspectRatio = 0 '取消纵横比
' Selection.ShapeRange.Width = W '设置宽度
' Selection.ShapeRange.Height = H '设置高度
'旧方法,仅插入链接
' ActiveSheet.Pictures.Insert(FilePath & Filename).S elect '插入图片
' Selection.ShapeRange.LockAspectRatio = 0 '取消纵横比
' Selection.ShapeRange.Width = W '设置宽度
' Selection.ShapeRange.Height = H '设置高度