Sub MapRanges()
Dim xmMap As XmlMap
Dim ws As Worksheet
Dim sPath As String
Dim loList As ListObject
Set ws = ThisWorkbook.Worksheets("Invoice")
Set xmMap = ThisWorkbook.XmlMaps("Invoice_Map")
Application.DisplayAlerts = False
Set loList = ws.ListObjects.Add(xlSrcRange, ws.Range("Qty").Resize(2, 4), , xlYes)
sPath = "/Invoice/Items/Item/Qty"
MapRepeatingRange loList.ListColumns(1), xmMap, sPath
Application.DisplayAlerts = True
Set xmMap = Nothing
Set ws = Nothing
Set loList = Nothing
End Sub
Function MapRepeatingRange(lcColumn As ListColumn, xmMap As XmlMap, _
sPath As String) As Boolean
On Error GoTo ErrHandler
lcColumn.XPath.SetValue xmMap, sPath
Exit Function
MapRepeatingRange = True
ErrHandler:
Debug.Print Err.Description
MapRepeatingRange = False
End Function
|