VBA/Excel/Access/Word/XML/XmlMap

Материал из VB Эксперт
Перейти к: навигация, поиск

Associating XML Elements with Ranges

   <source lang="vb">

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 
   sPath = "/Invoice/Customer/CustomerName" 
   MapRange ws.Range("CustomerName"), xmMap, sPath 
   Application.DisplayAlerts = True 
   Set xmMap = Nothing 
   Set ws = Nothing 
   Set loList = Nothing 

End Sub Function MapRange(rg As Range, xmMap As XmlMap, sPath As String) _

   As Boolean 
   On Error GoTo ErrHandler 
   If rg.XPath.Value = "" Then 
       rg.XPath.SetValue xmMap, sPath 
   Else 
       rg.XPath.Clear 
       rg.XPath.SetValue xmMap, sPath 
   End If 
   MapRange = True 
   Exit Function 

ErrHandler:

   MapRange = True 

End Function

</source>
   
  


Map Repeating Range

   <source lang="vb">

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

</source>