VBA/Excel/Access/Word/File Path/ListObject
Creating a Custom XML List
<source lang="vb"> Sub CreateXMLList() Dim oMyMap As XmlMap Dim strXPath As String Dim oMyList As ListObject Dim oMyNewColumn As ListColumn ThisWorkbook.XmlMaps.Add (ThisWorkbook.Path & "\Myschema.xsd") Set oMyMap = ThisWorkbook.XmlMaps("EmployeeSales_Map") Range("A1").Select Set oMyList = ActiveSheet.ListObjects.Add strXPath = "/EmployeeSales/Employee/Empid" oMyList.ListColumns(1).XPath.SetValue oMyMap, strXPath Set oMyNewColumn = oMyList.ListColumns.Add strXPath = "/EmployeeSales/Employee/InvoiceNumber" oMyNewColumn.XPath.SetValue oMyMap, strXPath Set oMyNewColumn = oMyList.ListColumns.Add strXPath = "/EmployeeSales/Employee/InvoiceAmount" oMyNewColumn.XPath.SetValue oMyMap, strXPath oMyList.ListColumns(1).Name = "EmployeeId" oMyList.ListColumns(2).Name = "Invoice Number" oMyList.ListColumns(3).Name = "Invoice Amount" End Sub </source>
Inspecting a ListObject
<source lang="vb">
" Example using various list properties Sub ListInfo()
Dim myWorksheet As Worksheet Dim lo As ListObject Dim lc As ListColumn Set myWorksheet = ThisWorkbook.Worksheets("ListObjects") Set lo = myWorksheet.ListObjects(1) For Each lc In lo.ListColumns Debug.Print lc.Name Debug.Print lc.Index Debug.Print lc.Range.Address Debug.Print GetTotalsCalculation(lc.TotalsCalculation) Next Debug.Print lo.HeaderRowRange.Address Debug.Print lo.DataBodyRange.Address If Not lo.InsertRowRange Is Nothing Then Debug.Print lo.InsertRowRange.Address Else Debug.Print "N/A" End If If lo.ShowTotals Then Debug.Print lo.TotalsRowRange.Address Else Debug.Print "N/A" End If Debug.Print lo.Range.Address Debug.Print lo.ShowTotals Debug.Print lo.ShowAutoFilter Set lc = Nothing Set lo = Nothing Set myWorksheet = Nothing
End Sub Function GetTotalsCalculation(xlCalc As XlTotalsCalculation) As String
Select Case xlCalc Case Is = XlTotalsCalculation.xlTotalsCalculationAverage GetTotalsCalculation = "Average" Case Is = XlTotalsCalculation.xlTotalsCalculationCount GetTotalsCalculation = "Count" Case Is = XlTotalsCalculation.xlTotalsCalculationCountNums GetTotalsCalculation = "CountNums" Case Is = XlTotalsCalculation.xlTotalsCalculationMax GetTotalsCalculation = "Max" Case Is = XlTotalsCalculation.xlTotalsCalculationMin GetTotalsCalculation = "Min" Case Is = XlTotalsCalculation.xlTotalsCalculationNone GetTotalsCalculation = "None" Case Is = XlTotalsCalculation.xlTotalsCalculationStdDev GetTotalsCalculation = "StdDev" Case Is = XlTotalsCalculation.xlTotalsCalculationSum GetTotalsCalculation = "Sum" Case Is = XlTotalsCalculation.xlTotalsCalculationVar GetTotalsCalculation = "Var" Case Else GetTotalsCalculation = "Unknown" End Select
End Function
</source>
To create a table from cells A1:F6, and assuming the table has column headers
<source lang="vb">
Sub table()
ActiveSheet.ListObjects.add(xlSrcRange, range("$A$1:$F$6"), , xlYes).name = "Table1"
End Sub
</source>