在Excel的單元格中使用VB或宏創建excel附件對象

Question

請指教如何使用宏在Excel單元格中創建對象。 請參考下面的圖片：

[

我想附上附件像的圖像，但使用腳本或任何形式的公式。

感謝

Answer 1

下面是我用我的評論中描述的方法創建了一個示例：宏

Excel中

'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 

---

更新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 

Answer 2

打開VBA編輯器（ALT + F11） 工具 - >引用 - >包含「Microsoft腳本運行時」
複製下面的代碼粘貼到Excel VBA
爲文檔路徑A1
運行
檢查輸出是否它適合你。

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