EXCEL中自动插入图片

发布网友 发布时间：2022-05-14 05:43

我来回答

共2个回答

热心网友 时间：2023-07-28 22:43

1.在sheet1的worksheet的change事件下面粘贴如下代码意思是sheet1单元格的内容有改变的时候,去调用加载图片的方法Call SetPicture(i, j)Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim j As Integeri = Target.Row
j = Target.ColumnCall SetPicture(i, j)
End Sub2.在模块中粘贴如下代码(FileExists()是一个函数,判断文件是否存在,SetPicture()是一个带参数的方法)Function FileExists(strPath As String) As Boolean
'判断文件是否存在
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
FileExists = fso.FileExists(strPath)
Set fso = Nothing
End Function
Public Sub SetPicture(i As Integer, j As Integer)
'加载图片
Dim PPath As String
If Not IsEmpty(Cells(i, j).Value) Then
PPath = ThisWorkbook.Path + "\" + Cells(i, j).Text '得到图片路径
If FileExists(PPath) Then 'FileExist函数判断图片是否存在
With Sheet1
.Cells(i, j + 1).Select
Picture = .Pictures.Insert(PPath).Name '插入图片
.Shapes(Picture).Name = "P" + Trim(Str(i)) + Trim(Str(j))
.Shapes(Picture).LockAspectRatio = msoFalse '设定图片大小
.Shapes(Picture).Placement = xlMoveAndSize
.Shapes(Picture).Left = .Cells(i, j + 1).Left
.Shapes(Picture).Top = .Cells(i, j).Top
.Shapes(Picture).Height = .Cells(i, j + 1).Height
.Shapes(Picture).Width = .Cells(i, j + 1).Width
End With
End If
Else
On Error Resume Next
Fname = "P" + Trim(Str(i)) + Trim(Str(j))
Sheet1.Shapes(Fname).Delete
End If
End Sub3.效果是在sheet1单元格输入图片名称(带後缀名如tu.jpg),自动在该单元格右边一个单元插入对应的图片,图片大小为该单元格的大小,当删除单元格图片名称时,插入的图片会跟著删除4.效果给你传到你的QQ邮箱,有不明白的地方请追问

热心网友 时间：2023-07-28 22:44

继续寻找高手