Le portail francophone de la géomatique

Public Sub ZoomCouche()
Dim pMxDoc As IMxDocument
Dim pMap As IMap
Dim pLayers As IEnumLayer
Dim pLayer As ILayer
Dim pFLayer As IFeatureLayer
Dim pFClass As IFeatureClass
Dim pQFilter As IQueryFilter

Dim pFCursor As IFeatureCursor
Dim pFeature As IFeature

Set pMxDoc = ThisDocument
Set pMap = pMxDoc.FocusMap
Set pLayers = pMap.Layers

Set pLayer = pLayers.Next
Do While Not pLayer Is Nothing
    If pLayer.Name = "NOM_COUCHE" Then
        If TypeOf pLayer Is IFeatureLayer Then
            Set pFLayer = pLayer
            Set pFClass = pFLayer.FeatureClass
            Set pQFilter = New QueryFilter
            pQFilter.WhereClause = "NOM_CHAMP = 'VALEUR'"
            Set pFCursor = pFClass.Search(pQFilter, False)
            Set pFeature = pFCursor.NextFeature
            If Not pFeature Is Nothing Then
                pMxDoc.ActiveView.Extent = pFeature.Extent
        
                pMxDoc.ActiveView.Refresh
            End If
        End If
        
        Set pFCursor = Nothing
        Set pQFilter = Nothing
        Set pFClass = Nothing
        Set pFLayer = Nothing
        
        Set pLayer = Nothing
    Else
        Set pLayer = pLayers.Next
    End If
Loop

Set pLayers = Nothing
Set pMap = Nothing
Set pMxDoc = Nothing

End Sub