Le portail francophone de la géomatique

Public Sub test()

Dim pMxDoc As IMxDocument
Dim pmap As IMap
Dim pfield As IField
Dim pLayer As ILayer
Dim pFLayer As IFeatureLayer
Dim pFeatureClass As IFeatureClass

Set pMxDoc = ThisDocument
Set pmap = pMxDoc.FocusMap
Set pLayer = pMxDoc.SelectedLayer
Set pFLayer = pLayer
Set pFeatureClass = pFLayer.FeatureClass

Dim pFeatureSelection As IFeatureSelection
Dim pSelectionSet As ISelectionSet
Dim pFCursor As IFeatureCursor


'Récupère la sélection
Set pFeatureSelection = pFLayer

'Vérifie qu'il existe bien une entité de sélectionner
If pFeatureSelection.SelectionSet.Count < 1 Then
    MsgBox "Aucune entité sélection sur la couche " & pLayer.Name
Exit Sub
End If
    
'Récupère les entités sélectionnées
Set pSelectionSet = pFeatureSelection.SelectionSet
'
'Récupère un curseur sur les entités sélectionnées


MsgBox "Nombre d'ojets selectionnées " & pSelectionSet.Count()

'enumération de la selection
Dim pEnumIDs As IEnumIDs
Set pEnumIDs = pSelectionSet.IDs

Dim pRowBuffer As IRowBuffer
Dim pFeature As IFeature

Dim id As Long
id = pEnumIDs.Next 'je parcours l'enumération de la sélection


Do
    Set pFeature = pFeatureClass.GetFeature(id) 'j'accède à la classe feature par son id
    Set pRowBuffer = pFeature 'je me place sur Irowbuffer
    Value = pRowBuffer.Value(0)
    MsgBox Value 'place du champ 0= champ 1, 1 = champ 2,etc...
    
    ' commande pour ajouter la valeur pRowBuffer à la listbox
    UserForm1.ListBox1.AddItem Value
    id = pEnumIDs.Next
Loop Until id = -1

End Sub

Private Sub UserForm_Initialize()
Call test
End Sub