Le portail francophone de la géomatique

Sub symbologie()
Dim pDoc As IMxDocument
Set pDoc = ThisDocument
Dim pMap As IMap
Set pMap = pDoc.FocusMap
Dim pLayer As ILayer
Set pLayer = pMap.Layer(0)
Dim pFLayer As IFeatureLayer
Set pFLayer = pLayer
Dim pLyr As IGeoFeatureLayer
Set pLyr = pFLayer
'créer une symbolisation et classifier les données
Dim pCBR As IClassBreaksRenderer
Set pCBR = New ClassBreaksRenderer
With pCBR
.BreakCount = 3
.Break(0) = 1
.Break(1) = 2
.Break(2) = 3
.Field = "repro_tota"
.Label(0) = "Adultes uniquement"
.Label(1) = "Reproduction possible"
.Label(2) = "Reproduction certaine"
End With

Dim pColorEnum As IEnumColors
Dim pAColorRamp As IAlgorithmicColorRamp
Dim pColor1 As IRgbColor
Dim pColor2 As IRgbColor
Dim pColor3 As IRgbColor
Dim pSMSym As ISimpleMarkerSymbol
Dim pSFSym As ISimpleFillSymbol

' couleur des symboles
Set pColor1 = New RgbColor
pColor1.RGB = RGB(255, 0, 0) ' ROUGE
Set pColor2 = New RgbColor
pColor2.RGB = RGB(0, 0, 0) ' blanc
Set pColor3 = New RgbColor
pColor3.RGB = RGB(255, 255, 255) ' blanc

' assigner la symbolisation de remplissage de chaque classe
Dim symbolesize As Integer
Dim halosize As Integer
symbolesize = 2

Set pSMSym = New SimpleMarkerSymbol
Set pSFSym = New SimpleFillSymbol

For i = 0 To 2

symbolesize = symbolesize + 6
pSMSym.Color = pColor1
pSMSym.Style = esriSMSCircle
pSMSym.size = symbolesize
pSMSym.Outline = True
pSMSym.OutlineSize = 0.8
pSMSym.OutlineColor = pColor2

pCBR.Symbol(i) = pSMSym

Next i

'assigner la symbolisation à la couche
Set pLyr.Renderer = pCBR
' Établir une en-tête de légende dans la table des matières de la légende (TOC)
Dim pLegendInfo As ILegendInfo
Set pLegendInfo = pCBR
pLegendInfo.LegendGroup(0).Heading = "Degré d'autochtonie"
' redessiner la table des matières (TOC) et la carte
pDoc.UpdateContents
pDoc.ActiveView.Refresh
End Sub