Question

我有一个excel文件，它根据某个工作表的内容导出xml。我不是这个宏的作者，我只想根据自己的需要操纵它。

剧本内的相关评论：

设计用于Excel内部作为宏而不是VB。如果你想从VB中使用添加代码来使用Excel对象模型
此代码段适用于名为＆＃34; dublin_core＆＃34;的工作表。在里面工作簿。
此代码使用＆＃34; dublin_core＆＃34;作为顶级XML属性。
假设工作表的第一行包含该属性（列）名称，而假定包含以下行数据值
第一行分为＆＃34;：＆＃34;字符。第一部分变成了＆＃34;元素＆＃34;第二个成为＆＃34;限定符＆＃34;。如果没有＆＃34;：＆＃34; （所以没有限定词）＆＃34;无＆＃34;使用。
没有空白单元格的数据写入XML文件。
该函数假定工作表中每行的第一列有价值。如果它找到空白的第一列，则退出。这是在为了防止它打印64,000个空白行

这是生成XML文件的代码的一部分：

    ' create the dublin_core.xml file
      iFileNum = FreeFile
      FullPath = oDirectory & "\" & Trim(Cells(i, lCols).Value) & "\" & "dublin_core.xml"
      Open FullPath For Output As #iFileNum

      Print #iFileNum, "<?xml version=""1.0"" encoding=""UTF-8""?>"
    'Print #iFileNum, "<" & sName & ">"

      Print #iFileNum, "<" & RowName & ">"

      For j = 1 To lCols - 1

      If Trim(Cells(i, j).Value) <> "" Then
        Dim vals As Variant
        vals = Split(asCols(j - 1), ":")

        If UBound(vals) = 0 Then
            ReDim vals(1)
            vals(0) = asCols(j - 1)
            vals(1) = "none"
            End If
      Print #iFileNum, "  <"; RowPrefix & " element=""" & vals(0) & """ qualifier=""" & vals(1) & """>";
       'Dim cellString As String
       cellString = Trim(Cells(i, j).Value)
       cellString = Replace(cellString, "& ", "&amp; ")
       cellString = Replace(cellString, "<", "&lt;")
       cellString = Replace(cellString, ">", "&gt;")
       cellString = Replace(cellString, "’", "&#146;")
       cellString = Replace(cellString, "‘", "&#145;")
       cellString = Replace(cellString, "'", "&apos;")
       cellString = Replace(cellString, """", "&quot;")
       cellString = Replace(cellString, "“", "&#147;")
       cellString = Replace(cellString, "”", "&#148;")
       cellString = Replace(cellString, "–", "-")
       cellString = Replace(cellString, "—", "-")
       cellString = Replace(cellString, "°", "&#176;")
       cellString = Replace(cellString, "µ", "&#181;")
       cellString = Replace(cellString, "ñ", "&#241;")
       cellString = Replace(cellString, "±", "&#177;")
       cellString = Replace(cellString, "§", "&#x0D;")
       cellString = Application.WorksheetFunction.Clean(cellString)



       Print #iFileNum, cellString;

       Print #iFileNum, "</" & RowPrefix & ">"
       DoEvents 'OPTIONAL
      End If
    Next j
    Print #iFileNum, " </" & RowName & ">"


    'Print #iFileNum, "</" & sName & ">"
      ExportToXML = True
      ErrorHandler:
      If iFileNum > 0 Then Close #iFileNum

      Next i
      Exit Function
      End Function

对于我的工作表的内容，例如我有这些条目：

title        | contributor:author | citation:spage | citation:epage | description: abstract
Sample title | Doe, John          | 45             | 50             | This is a sample abstract

现在，如果我运行宏，它将生成一个包含以下内容的XML文件：

<?xml version="1.0" encoding="UTF-8"?>
  <dublin_core>
    <dcvalue element="title" qualifier="none">Sample title</dcvalue>
    <dcvalue element="contributor" qualifier="author">Doe, John</dcvalue>
    <dcvalue element="citation" qualifier="spage">45</dcvalue>
    <dcvalue element="citation" qualifier="epage">50</dcvalue>
    <dcvalue element="description" qualifier="abstract">This is a sample abstract</dcvalue>
  </dublin_core>

我想要实现的是添加一个语言属性，使得生成的XML看起来像这样：

<?xml version="1.0" encoding="UTF-8"?>
  <dublin_core>
    <dcvalue element="title" qualifier="none" language="en">Sample title</dcvalue>
    <dcvalue element="contributor" qualifier="author">Doe, John</dcvalue>
    <dcvalue element="citation" qualifier="spage">45</dcvalue>
    <dcvalue element="citation" qualifier="epage">50</dcvalue>
    <dcvalue element="description" qualifier="abstract" language="en">This is a sample abstract</dcvalue>
  </dublin_core>

请注意，只有标题和 description：abstract 字段具有language="en"属性。我的问题是如何编辑代码，以便只有相关列具有language="en"属性？以前我做的是打开生成的XML并手动添加language="en"部分，如果我的工作表中有足够的记录，这是非常繁琐的。

提前致谢！

Answer 1

替换它：

If Trim(Cells(i, j).Value) <> "" Then
        Dim vals As Variant
        vals = Split(asCols(j - 1), ":")

        If UBound(vals) = 0 Then
            ReDim vals(1)
            vals(0) = asCols(j - 1)
            vals(1) = "none"
            End If
      Print #iFileNum, "  <"; RowPrefix & " element=""" & vals(0) & """ qualifier=""" & vals(1) & """>";
       'Dim cellString As String

使用：

Dim sContent, vals As Variant 'declare at top of procedure


If Trim(Cells(i, j).Value) <> "" Then

    vals = Split(asCols(j - 1), ":")
    ReDim Preserve vals(2) 'resize (if needed), preserving content

    If vals(1) = "" Then vals(1) = "none"

    sContent = "  <" & RowPrefix & " element=""" & vals(0) & _
             """ qualifier=""" & vals(1) & """"

    'add additional attribute?
    If Len(vals(2)) > 0 Then sContent = sContent & " language=""" & vals(2) & """"


    Print #iFileNum, sContent & ">";

为了避免硬编码哪些元素获得language="en"我已将其添加到标题中：例如 -

title                   >> title::en
description: abstract   >> description:abstract:fr

如何使用宏将属性添加到从excel导出的结果xml中

1 个答案: