使用Excel或Excel单元格中的宏创建Excel附件对象

时间:2016-08-29 09:12:24

标签: excel vba excel-vba macros

请告知如何使用宏在Excel单元格中创建对象。 请参考下图:

[Sample image

我想在图片中添加附件,但使用脚本或任何类型的公式。

由于

2 个答案:

答案 0 :(得分:1)

这是我使用评论中描述的方法创建的示例:

Excel宏

volatile int

更新1

如果在第一列中提供了元素的路径,请使用此链接添加相应的链接:

'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 :(得分:0)

打开VBA编辑器(Alt + F11)    工具 - >引用 - >包括“Microsoft Scripting Runtime”
   将以下代码复制并粘贴到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