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

使用VBA将附件插入XML标签

1 个答案: