Le portail francophone de la géomatique

Private Sub jointure_Click()
MsgBox "jointure 1"
'Jointure
 ' Part 1: Define the feature cReportlass.
    Dim pMxDoc As IMxDocument
    Dim pMap As IMap
    Dim pFeatureLayer As IFeatureLayer
    Dim pFeatureClass As IFeatureClass
    Set pMxDoc = ThisDocument
    Set pMap = pMxDoc.FocusMap
    Set pFeatureLayer = pMap.Layer(0)
    Set pFeatureClass = pFeatureLayer.FeatureClass
      
    ' Part 2: Define the table to be joined.
    Dim pTabCollection As IStandaloneTableCollection
    Dim pStTable As IStandaloneTable
    Dim pFromTable As ITable
    Set pTabCollection = pMap
    Set pStTable = pTabCollection.StandaloneTable(0)
    Set pFromTable = pStTable.Table
    
    ' Part 3: Join the table to the feature class.
    Dim strJnField As String
    Dim pMemRelFact As IMemoryRelationshipClassFactory
    Dim pRelClass As IRelationshipClass
    Dim pDispRC As IDisplayRelationshipClass
    ' Prompt for the join field.
    strJnField = "CODE"
   ' Create a memory relationship class.
    Set pMemRelFact = New MemoryRelationshipClassFactory
    Set pRelClass = pMemRelFact.Open("TableToLayer", pFromTable, strJnField, pFeatureClass, _
    strJnField, "wp", "wpdata", esriRelCardinalityOneToOne)
    ' Perform a join.
    Set pDispRC = pFeatureLayer
    pDispRC.DisplayRelationshipClass pRelClass, esriLeftOuterJoin
    MsgBox " fin jointure "
    Call Aya_devis
End Sub

Private Sub Aya_devis()
MsgBox "Aya"

    Dim pMxDoc As IMxDocument
    Dim pFeatureLayer As IFeatureLayer
    Dim pFeatureSelection As IFeatureSelection
    Dim pSelectionSet As ISelectionSet
    Dim pFeatureCursor As IFeatureCursor
    Dim pFeature1 As IFeature
    Dim pFeature2 As IFeature
    Dim pFeature3 As IFeature
    
    Set pMxDoc = ThisDocument
    Set pFeatureLayer = pMxDoc.FocusMap.Layer(0)
    Set pFeatureSelection = pFeatureLayer
    Set pSelectionSet = pFeatureSelection.SelectionSet

    pSelectionSet.Search Nothing, False, pFeatureCursor
    Set pFeature1 = pFeatureCursor.NextFeature
    Do While Not pFeature1 Is Nothing
MsgBox pFeature1.Value(9)
Set pFeature1 = pFeatureCursor.NextFeature
Loop
End Sub