Le portail francophone de la géomatique

Public Sub test()
    'recuperation du document
    Dim pmxdoc As IMxDocument
    Set pmxdoc = ThisDocument
    'recuperation du bloc de données actif
    Dim pmap As IMap
    Set pmap = pmxdoc.FocusMap
    'recuperation des couches sous forme d'enumeration
    Dim players As IEnumLayer
    Set players = pmap.Layers
    'recuperation de la premiere couche de l'enumeration players
    Dim player As ILayer
    Set player = players.Next
    'creation de l'outil d'export arcmap
    Dim pexportoperation As IExportOperation
    Set pexportoperation = New ExportOperation
    
    'tant qu'il y une couche
    Do Until player Is Nothing
        'si la couche est de type vectorielle
        If TypeOf player Is IFeatureLayer Then
            'changement d'interface
            Dim pfl As IFeatureLayer
            Set pfl = player
            
            'RECUPERATION DES INFOS NECESSAIRES A L'EXPORT
            'recuperation de classe d'entites et changement d'interface
            Dim pds As IDataset
            Set pds = pfl.FeatureClass
            'recuparation du nom complet du dataset
            Dim pdsname As IDatasetName
            Set pdsname = pds.FullName
            'recuperation du nom du champ stockant la geometrie
            Dim sShpName As String
            sShpName = pfl.FeatureClass.ShapeFieldName
            'recuperation de la collection de champs de la classe d'entites
            Dim pFields As IFields
            Set pFields = pfl.FeatureClass.Fields
            'recuperation de l'index du champ contenant la geometrie
            Dim lGeomIndex As Long
            lGeomIndex = pFields.FindField(sShpName)
            'recuperation du champ contenant la geometrie
            Dim pField As IField
            Set pField = pFields.Field(lGeomIndex)
            'recuperation de la definition de la geometrie
            Dim pGeometryDef As IGeometryDef
            Set pGeometryDef = pField.GeometryDef
            'creation du workspacefactory de type shapefile
            Dim pWkSpFactory As IWorkspaceFactory
            Set pWkSpFactory = New ShapefileWorkspaceFactory
            'creation de l'espace de travail de sortie(repertoire "c:\temp" par exemple)
            Dim pWkSp As IWorkspace
            Set pWkSp = pWkSpFactory.OpenFromFile("c:\temp", 0)
            'changement d'interface
            Dim pWkSpDS As IDataset
            Set pWkSpDS = pWkSp
            'changement d'interface pour recuperer les infos sur le workspace
            Dim pWkSpName As IWorkspaceName
            Set pWkSpName = pWkSpDS.FullName
            'creation d'un featureclassname (shapefile de sortie)
            Dim pOutDSName As IDatasetName
            Set pOutDSName = New FeatureClassName
            'affectation du nom du shapefile en sortie (par exemple le nom de la couche sur laquelle on travaille)
            pOutDSName.Name = player.Name
            'affectation de l'espace de travail en sortie au shapefile en sortie
            Set pOutDSName.WorkspaceName = pWkSpName
            'export du shapefile
            pexportoperation.ExportFeatureClass pdsname, Nothing, Nothing, pGeometryDef, pOutDSName, 0
        End If
        'on passe a la couche suivante
        Set player = players.Next
    Loop
End Sub