Хорошо, я прикусила пулю и написала хороший старый макрос VBA. Я подумал, что поделюсь этим со всеми вами на случай, если кто-то столкнется с той же проблемой.
Этот макрос в основном вызывает встроенный в Excel метод XML Export (), а затем выполняет серию замен текста в результирующем файле. Замена текста полностью на ваше усмотрение. Просто поместите их в таблицу, как показано в ссылке ниже ...
Пример того, как настроить «правила замены»:
Нажмите меня, чтобы открыть экран
В этом примере я заменил табуляцию пробелом, ": ns1" пустым, "ns1:" пустым, а урезанный корневой элемент оригинальным корневым элементом.
Вы можете отформатировать правила замены любым удобным вам способом, если вы будете следовать этим инструкциям:
- Выберите все ячейки "найти что" и дайте им имя * "FindWhat" (не включайте строку заголовка в ваш выбор; пробелы будут игнорироваться).
- Выберите все ячейки «заменить на» и дайте им имя * «Заменить на» (между ячейками «найти что» и «заменить на» должно быть взаимно-однозначное соответствие; используйте пробелы для удаления нежелательного текста) ).
- Введите имя карты XML где-нибудь в своей рабочей книге и назовите эту ячейку "XmlMap".
- Запустить макрос. (Вам будет предложено указать файл, в который вы хотите экспортировать.)
* Если вы не знакомы с диапазонами именования в Excel 2007, перейдите на вкладку Формулы и выберите «Диспетчер имен».
Хорошо, я больше не буду держать вас в напряжении (LOL) ... вот код для макроса. Просто поместите его в модуль в редакторе VBA. С этим бесплатным кодом я не даю никаких гарантий (его можно легко сломать, если вы не назовете диапазоны должным образом), но пара примеров, которые я пробовал, сработали для меня.
Option Explicit
Sub ExportXml()
Dim exportResult As XlXmlExportResult
Dim exportPath As String
Dim xmlMap As String
Dim fileContents As String
exportPath = RequestExportPath()
If exportPath = "" Or exportPath = "False" Then Exit Sub
xmlMap = range("XmlMap")
exportResult = ActiveWorkbook.XmlMaps(xmlMap).Export(exportPath, True)
If exportResult = xlXmlExportValidationFailed Then
Beep
Exit Sub
End If
fileContents = ReadInTextFile(exportPath)
fileContents = ApplyReplaceRules(fileContents)
WriteTextToFile exportPath, fileContents
End Sub
Function ApplyReplaceRules(fileContents As String) As String
Dim replaceWorksheet As Worksheet
Dim findWhatRange As range
Dim replaceWithRange As range
Dim findWhat As String
Dim replaceWith As String
Dim cell As Integer
Set findWhatRange = range("FindWhat")
Set replaceWithRange = range("ReplaceWith")
For cell = 1 To findWhatRange.Cells.Count
findWhat = findWhatRange.Cells(cell)
If findWhat <> "" Then
replaceWith = replaceWithRange.Cells(cell)
fileContents = Replace(fileContents, findWhat, replaceWith)
End If
Next cell
ApplyReplaceRules = fileContents
End Function
Function RequestExportPath() As String
Dim messageBoxResult As VbMsgBoxResult
Dim exportPath As String
Dim message As String
message = "The file already exists. Do you want to replace it?"
Do While True
exportPath = Application.GetSaveAsFilename("", "XML Files (*.xml),*.xml")
If exportPath = "False" Then Exit Do
If Not FileExists(exportPath) Then Exit Do
messageBoxResult = MsgBox(message, vbYesNo, "File Exists")
If messageBoxResult = vbYes Then Exit Do
Loop
RequestExportPath = exportPath
End Function
Function FileExists(path As String) As Boolean
Dim fileSystemObject
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
FileExists = fileSystemObject.FileExists(path)
End Function
Function ReadInTextFile(path As String) As String
Dim fileSystemObject
Dim textStream
Dim fileContents As String
Dim line As String
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
Set textStream = fileSystemObject.OpenTextFile(path)
fileContents = textStream.ReadAll
textStream.Close
ReadInTextFile = fileContents
End Function
Sub WriteTextToFile(path As String, fileContents As String)
Dim fileSystemObject
Dim textStream
Set fileSystemObject = CreateObject("Scripting.FileSystemObject")
Set textStream = fileSystemObject.CreateTextFile(path, True)
textStream.Write fileContents
textStream.Close
End Sub