EXCEL导出为指定的XML.doc

导出前的EXCEL导出后的XML格式Dim xmldoc As DOMDocumentDim ver As VariantDim Col As IntegerDim Row As IntegerDim i As IntegerDim j As IntegerDim k As IntegerPrivate Sub SaveAsXML_Click()Row = Application.WorksheetFunction.CountA(Columns(E)MsgBox Cells(1, 1).ValueSet xmldoc = New DOMDocumentSet ver = xmldoc.createProcessingInstruction(xml, version= & Chr(34) & 1.0 & Chr(34) & encoding=gb2312)xmldoc.appendChild verSet Deliverynode = xmldoc.createElement(Delivery)xmldoc.appendChild DeliverynodeFor i = 2 To Row - 1If IsEmpty(Cells(i, C) = False ThenSet Ordernode = xmldoc.createElement(订单)CreateAttribute Ordernode, 单据编号, Cells(i, C)Deliverynode.appendChild Ordernode CreateNode Ordernode, 购货单位, Cells(i, B) CreateNode Ordernode, 日期, Cells(i, A) Set Detailnode = xmldoc.createElement(Detail) Ordernode.appendChild Detailnode If IsEmpty(Cells(i, C) = False Then Set Catalognode = xmldoc.createElement(Catalog) CreateAttribute Catalognode, 规格型号, Cells(i, D) Detailnode.appendChild Catalognode CreateNode Catalognode, 规格型号, Cells(i, D) CreateNode Catalognode, 数量, Cells(i, E) Set Barcodenode = xmldoc.createElement(Barcode) Catalognode.appendChild Barcodenode If Cells(i, 6).Value = ok Or Cells(i, 6).Value = OK Then CreateNode Barcodenode, 编码, Cells(i, F) Else For k = 1 To Cells(i, 5).Value CreateNode Barcodenode, 编码, Cells(i, k + 5) Next End If For j = i + 1 To Row - 1 If IsEmpty(Cells(j, C) = True Then Set Catalognode = xmldoc.createElement(Catalog) CreateAttribute Catalognode, 规格型号, Cells(j, D) Detailnode.appendChild Catalognode CreateNode Catalognode, 数量, Cells(j, E) Set Barcodenode = xmldoc.createElement(Barcode) Catalognode.appendChild Barcodenode If Cells(j, 6).Value = ok Or Cells(j, 6).Value = OK Then CreateNode Barcodenode, 编码, Cells(j, F) Else For k = 1 To Cells(j, 5).Value CreateNode Barcodenode, 编码, Cells(j, k + 5) Next End If Else i = j - 1 Exit For End If Next End If End If Nextxmldoc.save C:Documents and SettingsAdministrator桌面转换后.xmlEnd SubPrivate Sub CreateNode(ByVal parent As IXMLDOMNode, ByVal nodename As String, ByVal valNode As String)Dim newnode As IXMLDOMNodeSet newnode = parent.ownerDocument.createElement(nodename)newnode.Text = valNodeparent.appendChild newnodeEnd SubPrivate Function CreateAttribute(ByVal valNode As IXMLDOMNode, ByVal Name As String, ByVal Value As String) As IXMLDOMAttribute Dim xmlattributeAny As IXMLDOMAttribute Set xmlattributeAny = valNode.ownerDocument.CreateAttribute(Name) xmlattributeAny.Value = Value Call