Le portail francophone de la géomatique

Public Sub CreateSummaryTable()
  
  On Error GoTo EH
  
  Dim pDoc As IMxDocument
  Set pDoc = ThisDocument
  Dim pMap As IMap
  Set pMap = pDoc.FocusMap

  ' Find the layer named US_Counties
  Dim pLayer As ILayer
  Dim pFeatLayer As IFeatureLayer
  Dim intCount As Integer
  For intCount = 0 To pMap.LayerCount - 1
    Set pLayer = pMap.Layer(intCount)
    If TypeOf pLayer Is IFeatureLayer Then
      If pLayer.Name = "XXXX" Then
        Set pFeatLayer = pLayer
        Exit For
      End If
    End If
  Next
  If pFeatLayer Is Nothing Then
    MsgBox "The XXXX layer was not found"
    Exit Sub
  End If

  ' Get the workspace of the DDASS layer
  Dim pFeatClass As IFeatureClass
  Dim pTable As ITable
  Dim pDataSet As IDataset
  Dim pWkSpDS As IDataset
  Dim pWkSpName As IName
  Set pFeatClass = pFeatLayer.FeatureClass
  Set pTable = pFeatClass
  Set pDataSet = pTable
  Set pWkSpDS = pDataSet.Workspace
  Set pWkSpName = pWkSpDS.FullName
    
  ' The output is set to SumSample.dbf file in c:\temp
  Dim pWkSpFactory As IWorkspaceFactory
  Dim pWkSp As IWorkspace
  ' Dim pWkSpDS As IDataset
  ' Dim pWkSpName As IWorkspaceName
  Dim pOutDSName As IDatasetName
  Set pWkSpFactory = New ShapefileWorkspaceFactory
  Set pWkSp = pWkSpFactory.OpenFromFile("c:\temp", 0)
  Set pWkSpDS = pWkSp
  Set pWkSpName = pWkSpDS.FullName
  Set pOutDSName = New TableName
  pOutDSName.Name = "SumSample"
  Set pOutDSName.WorkspaceName = pWkSpName
  
  ' Make sure there is a field called state_name in the layer
  If pTable.FindField("test") = -1 Then
    MsgBox "There must be a field named state_name in XXXX"
    Exit Sub
  End If
  
  ' Perform the summarize. Note the summary fields string (minimum.state_name ...)
  ' below. This is a comma-delimited string that lists the generated summary
  ' fields. Each field must start with a keyword, and be followed by .fieldName,
  ' where fieldName is the name of a field in the original table.
  '
  ' If you specify the Shape field, you must use the keyword 'Dissolve'. This
  ' is not used below since we are creating a non-spatial summary table.
  Dim pGeoProc As IBasicGeoprocessor
  Dim pSumTable As ITable
  Set pGeoProc = New BasicGeoprocessor
  Set pSumTable = pGeoProc.Dissolve(pTable, False, "test", "Minimum.test, Count.test, Maximum.test,Minimum.test1, Maximum.test1", pOutDSName)
    
  ' add the table to map
  Dim pStTab As IStandaloneTable
  Set pStTab = New StandaloneTable
  Set pStTab.table = pSumTable
  Dim pStTabColl As IStandaloneTableCollection
  Set pStTabColl = pMap
  pStTabColl.AddStandaloneTable pStTab

  ' Refresh the TOC
  pDoc.UpdateContents

  Exit Sub
EH:

  MsgBox Err.Number & " " & Err.Description

End Sub