VBA/Excel/Access/Word/File Path/ListObject

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

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>