Excel 2013 - VBA XML 重新启动时绑定中断

Question

我很复杂XSD。在 excel 开发人员中，在 XML 部分我可以单击 "source" 并将 XSD 添加到数据源映射，然后将节点映射到特定的单元格、行等

然后我可以按预期输入数据并导出 XML，很好。当我重新打开保存的 XLS 时，发生了一些奇怪的事情，excel 说我的 XML 地图已损坏并要求删除损坏的地图并显示他认为错误的一个节点。但是所有选项都是灰色的，我找到的唯一选项是通过 VBA、

删除地图

ActiveWorkbook.XmlMaps("JPK_mapa").Delete

但是当删除地图时，所有映射都消失了，我必须再次添加地图并手动完成所有映射。这对我来说并不难，但普通用户可能会遇到问题，我只想给他们 XLS 来填充数据。

我无法更改 XSD，对其内容没有影响，所以我假设我必须接受它并教 excel 以某种方式在自动启动时删除和再次添加此映射。由于有很多映射，而且只需在 excel 中单击几下，我很乐意将其录制为宏。但是当我打开录音时它不记录我做的映射。

Q1：有什么方法可以记录映射的生成？或者有没有办法以某种方式使该过程自动化？

我也发现了一件有趣的事。如果我打开 map-broken xlsx 为 zip 并从中删除 xmlMaps.xml，再次打开 xls 后，我可以打开 XML 数据源，当我添加 xsd 时，所有映射都被恢复并且正确绑定到 xls 中的单元格（在附加图片中标记为粗体）。这让我问问题 2.

问题 2：有没有一种方法可以删除 VBA 中的映射，以便再次添加时它会记住这些映射？

希望大家多多指教，谢谢

Answer 1

我找到了解决问题的方法。不完全是我预期的方式，但工作正常。我所做的是在 excel 文件打开时重建地图。我将字段映射保存到单独的隐藏工作表中的模式，当文件打开时，我删除旧模式，添加新模式并添加映射。该过程对用户透明。

    Private Sub Auto_Open()
        Dim myMap As XmlMap

        ActiveWorkbook.XmlMaps(1).Delete
        Set myMap = ActiveWorkbook.XmlMaps.Add(Application.ActiveWorkbook.Path & "\JPK_VAT2v1-0.xsd", "JPK")
        myMap.Name = "JPK_mapa"



     A = True
     row = 1
     While A
        If (Worksheets("Maps").Range("A" & row).Value <> "") Then

            mySheet = Worksheets("Maps").Range("A" & row).Value
            mycell = Worksheets("Maps").Range("B" & row).Value
            myXpath = Worksheets("Maps").Range("D" & row).Value
            ret = Worksheets(mySheet).Range(mycell).XPath.SetValue(myMap, myXpath)
            row = row + 1

        Else
            A = False
        End If
     Wend
     End Sub

地图工作表如下所示：

    ColA    ColB    ColC        ColD

    Start   $B    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodFormularza
    Start   $C    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodFormularza/@kodSystemowy
    Start   $D    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodFormularza/@wersjaSchemy
    Start   $E    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:WariantFormularza
    Start   $F    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:CelZlozenia
    Start   $G    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DataWytworzeniaJPK
    Start   $H    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DataOd
    Start   $I    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DataDo
    Start   $J    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:DomyslnyKodWaluty
    Start   $K    JPK_mapa    /ns1:JPK/ns1:Naglowek/ns1:KodUrzedu
    Start   $B    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:IdentyfikatorPodmiotu/ns2:NIP
    Start   $C    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:IdentyfikatorPodmiotu/ns2:PelnaNazwa
    Start   $D    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:IdentyfikatorPodmiotu/ns2:REGON
    Start   $E    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:KodKraju
    Start   $F    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Wojewodztwo
    Start   $G    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Powiat
    Start   $H    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Gmina
    Start   $I    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Ulica
    Start   $J    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:NrDomu
    Start   $K    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:NrLokalu
    Start   $L    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Miejscowosc
    Start   $M    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:KodPocztowy
    Start   $N    JPK_mapa    /ns1:JPK/ns1:Podmiot1/ns1:AdresPodmiotu/ns1:Poczta
    Sprzedaz    $B    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/@typ
    Sprzedaz    $C    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:LpSprzedazy
    Sprzedaz    $D    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:NrKontrahenta
    Sprzedaz    $E    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:NazwaKontrahenta
    Sprzedaz    $F    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:AdresKontrahenta
    Sprzedaz    $G    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:DowodSprzedazy
    Sprzedaz    $H    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:DataWystawienia
    Sprzedaz    $I    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:DataSprzedazy
    Sprzedaz    $J    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_10
    Sprzedaz    $K    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_11
    Sprzedaz    $L    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_12
    Sprzedaz    $M    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_13
    Sprzedaz    $N    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_14
    Sprzedaz    $O    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_15
    Sprzedaz    $P    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_16
    Sprzedaz    $Q    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_17
    Sprzedaz    $R    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_18
    Sprzedaz    $S    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_19
    Sprzedaz    $T    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_20
    Sprzedaz    $U    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_21
    Sprzedaz    $V    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_22
    Sprzedaz    $W    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_23
    Sprzedaz    $X    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_24
    Sprzedaz    $Y    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_25
    Sprzedaz    $Z    JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_26
    Sprzedaz    $AA   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_27
    Sprzedaz    $AB   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_28
    Sprzedaz    $AC   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_29
    Sprzedaz    $AD   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_30
    Sprzedaz    $AE   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_31
    Sprzedaz    $AF   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_32
    Sprzedaz    $AG   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_33
    Sprzedaz    $AH   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_34
    Sprzedaz    $AI   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_35
    Sprzedaz    $AJ   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_36
    Sprzedaz    $AK   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_37
    Sprzedaz    $AL   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_38
    Sprzedaz    $AM   JPK_mapa    /ns1:JPK/ns1:SprzedazWiersz/ns1:K_39
    SprzedazCTRL    $B    JPK_mapa    /ns1:JPK/ns1:SprzedazCtrl/ns1:LiczbaWierszySprzedazy
    SprzedazCTRL    $C    JPK_mapa    /ns1:JPK/ns1:SprzedazCtrl/ns1:PodatekNalezny
    Zakup   $B    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/@typ
    Zakup   $C    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:LpZakupu
    Zakup   $D    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:NrDostawcy
    Zakup   $E    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:NazwaDostawcy
    Zakup   $F    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:AdresDostawcy
    Zakup   $G    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:DowodZakupu
    Zakup   $H    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:DataZakupu
    Zakup   $I    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:DataWplywu
    Zakup   $J    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_43
    Zakup   $K    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_44
    Zakup   $L    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_45
    Zakup   $M    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_46
    Zakup   $N    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_47
    Zakup   $O    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_48
    Zakup   $P    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_49
    Zakup   $Q    JPK_mapa    /ns1:JPK/ns1:ZakupWiersz/ns1:K_50
    ZakupCTRL   $B    JPK_mapa    /ns1:JPK/ns1:ZakupCtrl/ns1:LiczbaWierszyZakupow
    ZakupCTRL   $C    JPK_mapa    /ns1:JPK/ns1:ZakupCtrl/ns1:PodatekNaliczony

我还编写了一个小函数来根据实际映射的内容制作地图工作表，这样我就不必手动编写地图工作表的内容。这是基于我在我的 excel 文件和工作表中存储映射字段的方式，但我认为它应该对如何实现这一点有所了解，也许有人会觉得它有用:-) 因此，当我更改一些映射时，我只是运行手动 makeMap 函数并生成地图工作表。

    Sub makeMap()
        mapRow = store("Start", 2, 1)
        mapRow = store("Start", 5, mapRow)
        mapRow = store("Sprzedaz", 1, mapRow)
        mapRow = store("SprzedazCTRL", 2, mapRow)
        mapRow = store("Zakup", 1, mapRow)
        mapRow = store("ZakupCTRL", 2, mapRow)
    End Sub

    Function store(Sh As String, row As Integer, ByVal mapRow As Integer) As Integer


        Dim mySheet As Worksheet
        Set mySheet = Worksheets(Sh)


        myRow = row
        mycell = ""

        For cols = 2 To 50
        hasXpath = mySheet.Cells(row, cols).XPath

        If Not hasXpath = Empty Then

            Worksheets("Maps").Range("A" & mapRow).Value = Sh
            Worksheets("Maps").Range("B" & mapRow).Value = mySheet.Cells(row, cols).Address
            Worksheets("Maps").Range("C" & mapRow).Value = mySheet.Cells(row, cols).XPath.Map
            Worksheets("Maps").Range("D" & mapRow).Value = mySheet.Cells(row, cols).XPath
            mapRow = mapRow + 1
       End If



       Next cols
       store = mapRow
    End Function

Excel 2013 - VBA XML 重新启动时绑定中断

Excel 2013 - VBA XML binding broken on restart

xml

excel

xmlmapper

vba