'Select the cell that should contain the object
Range("B5").Select
'Add an object to the given cell
ActiveSheet.OLEObjects.Add(Filename:= _
"C:\Users\de12668\Documents\Zeichnung1.vsd", Link:=False, DisplayAsIcon:= _
True, IconFileName:= _
"C:\WINDOWS\Installer\{90140000-0057-0000-0000-0000000FF1CE}\visicon.exe", _
IconIndex:=0, IconLabel:="A sample"). _
Select
Update 1
如果在第一列中提供了元素的路径，请使用此链接添加相应的链接：
Dim myRange As range
Dim longLastRow As Long
Dim counter As Long
Set myRange = Worksheets(1).range("A1")
longLastRow = Cells(Rows.Count, myRange.Column).End(xlUp).Row
For counter = 1 To longLastRow
range("B" & counter).Select
ActiveSheet.OLEObjects.Add(Filename:= _
range("A" & counter).Value, Link:=False, DisplayAsIcon:= _
True, IconFileName:= _
range("A" & counter).Value, _
IconIndex:=0, IconLabel:=""). _
Select
Next
Sub CreateObject()
Dim shpGroup As Shape
Dim shpTextbox As Shape
Dim fso As New FileSystemObject
Dim mfile As File
Dim mfolder As Folder
Dim mpath As String
Dim mrow As Integer
mpath = ActiveSheet.Range("A1").Value 'Path of the document files in the local system
mrow = 2
If fso.FolderExists(mpath) Then
Set mfolder = fso.GetFolder(mpath)
For Each mfile In mfolder.Files
ActiveSheet.Hyperlinks.Add Anchor:=ActiveSheet.Range("A" & mrow), _
Address:=mfile.ShortPath, _
TextToDisplay:=mfile.ShortPath
ActiveSheet.Range("A" & mrow).Value = mfile.ShortPath
Set shpGroup = ActiveSheet.Shapes.AddPicture("C:\inetpub\wwwroot\learn\sun.jpg", msoFalse, msoTrue, 0, 0, 50, 50) 'give the Image path
shpGroup.LockAspectRatio = msoFalse
shpGroup.Left = ActiveSheet.Range("B" & mrow).Left
shpGroup.Top = ActiveSheet.Range("B" & mrow).Top
shpGroup.Width = ActiveSheet.Range("B" & mrow).Width
shpGroup.Height = ActiveSheet.Range("B" & mrow).Height
mrow = mrow + 1
Next
End If
Set mfile = Nothing
Set mfolder = Nothing
Set fso = Nothing
End Sub
2 回答
这是我使用我的评论中描述的方法创建的示例：
Excel macro
Update 1
如果在第一列中提供了元素的路径，请使用此链接添加相应的链接：
打开VBA编辑器（Alt F11）工具 - >参考 - >包含"Microsoft Scripting Runtime"
将以下代码复制并粘贴到excel VBA中
在A1中提供文档路径
跑
检查输出是否适合您 .