excel - 使用 VBA 将附件插入 XML 标记

Question

我正在使用以下代码循环访问电子表格中的数据以创建 XML 文件:

Private Sub btn_Submit_Click()
    Dim colIndex As Integer
    Dim rwIndex As Integer
    Dim asCols() As String
    Dim oWorkSheet As Worksheet
    Dim sName As String
    Dim lCols As Long, lRows As Long
    Dim iFileNum As Integer
    Dim str_switch As String ' To use first column as node
    Dim blnSwitch As Boolean
    Dim rng As Range

    For Each rng In ActiveSheet.UsedRange
        If Application.WorksheetFunction.IsText(rng) Then
            i = i + 1
        End If
    Next rng

    Set oWorkSheet = ThisWorkbook.Worksheets("Sheet1")
    sName = oWorkSheet.Name
    lCols = i

    iFileNum = FreeFile
    Open "C:\temp\test2.xml" For Output As #iFileNum

    Print #iFileNum, "<?xml version=""1.0""?>"
    Print #iFileNum, "<" & sName & ">" ' add sheet name to xml file as First Node
    i = 1
    Do Until i = lCols + 1
        Print #iFileNum, " <" & oWorkSheet.Cells(1, i).Text & ">" & Trim(oWorkSheet.Cells(2, i).Value) & "</" & oWorkSheet.Cells(1, i).Text & ">"
        i = i + 1
    Loop

    Print #iFileNum, "</" & sName & ">"

    Close #iFileNum
    MsgBox ("Complete")
ErrorHandler:
    If iFileNum > 0 Then Close #iFileNum
    Exit Sub
End Sub

这个过程完美地创建了我想要的标签名称，并插入了输入的文本。问题出现在我需要使用以下一小段代码插入存储在其中一个单元格中的附件时:

Set rng = Range("AH2")  'Name the cell in which you want to place the attachment
rng.RowHeight = 56
On Error Resume Next
fpath = Application.GetOpenFilename("All Files,*.*", Title:="Select file", MultiSelect:=True)
For i = 1 To UBound(fpath)
    rng.Select
    rng.ColumnWidth = 12
    ActiveSheet.OLEObjects.Add _
    Filename:=fpath(i), _
    Link:=False, _
    DisplayAsIcon:=True, _
    IconFileName:="excel.exe", _
    IconIndex:=0, _
    IconLabel:=extractFileName(fpath(i))
    Set rng = rng.Offset(0, 1)
Next i
MsgBox ("Document Uploaded")

由于某种原因，该文档未出现在其相关标签中。有谁知道我哪里出错了，或者我是否在尝试不可能的事情!

Answer 1

您必须声明 OleObject 的变量类型:

Dim ol As OLEObject

然后，在 for next 循环中:

Set ol = ActiveSheet.OLEObjects.Add(....)
With ol
    .Top = rng.Top
    .Left = rng.Left
End With

更多详情，请参阅:vba macro to embed OLEobject based on cell