複数フィールドによる個別値分類

'元サンプル
'http://resources.esri.com/help/9.3/ArcGISDesktop/ArcObjects/esriCarto/IUniqueValueRenderer_Example.htm
 
Sub CreateAndApplyUVRenderer()
     '** Paste into VBA
     '** Creates a UniqueValuesRenderer and applies it to first layer in the map.
     '** Layer must have "Name" field
      
      
     '<--追加（フィールドを定義）
     Dim strField1 As String
     Dim strField2 As String
     strField1 = "PREF"
     strField2 = "CITY1"
  
     Dim pApp As Application
     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
      
     Dim pFeatCls As IFeatureClass
     Set pFeatCls = pFLayer.FeatureClass
     Dim pQueryFilter As IQueryFilter
     Set pQueryFilter = New QueryFilter 'empty supports: SELECT *
     Dim pFeatCursor As IFeatureCursor
     Set pFeatCursor = pFeatCls.Search(pQueryFilter, False)
  
     '** Make the color ramp we will use for the symbols in the renderer
     Dim rx As IRandomColorRamp
     Set rx = New RandomColorRamp
     rx.MinSaturation = 20
     rx.MaxSaturation = 40
     rx.MinValue = 85
     rx.MaxValue = 100
     rx.StartHue = 76
     rx.EndHue = 188
     rx.UseSeed = True
     rx.Seed = 43
      
     '** Make the renderer
     Dim pRender As IUniqueValueRenderer, n As Long
     Set pRender = New UniqueValueRenderer
      
     pRender.FieldDelimiter = ","                                               '<--追加（複数フィールドを区切る文字列を設定）
      
     Dim symd As ISimpleFillSymbol
     Set symd = New SimpleFillSymbol
     symd.Style = esriSFSSolid
     symd.Outline.Width = 0.4
      
     '** These properties should be set prior to adding values
     pRender.FieldCount = 2                                                     '<--変更（個別値分類に使用するフィールド数）
     pRender.Field(0) = strField1
     pRender.Field(1) = strField2                                               '<--変更（複数フィールドによる個別値で使用するフィールド名）
      
     pRender.DefaultSymbol = symd
     pRender.UseDefaultSymbol = True
      
     Dim pFeat As IFeature
     n = pFeatCls.FeatureCount(pQueryFilter)
     '** Loop through the features
     Dim i As Integer
     i = 0
     Dim ValFound As Boolean
     Dim NoValFound As Boolean
     Dim uh As Integer
     Dim pFields As IFields
     Dim iField As Integer
     Set pFields = pFeatCursor.Fields
     iField = pFields.FindField(strField1)
      
      
     Dim iField2 As Integer                                                     '<--追加（2つめのフィールド名）
     iField2 = pFields.FindField(strField2)                                     '<--追加
      
     Do Until i = n
         Dim symx As ISimpleFillSymbol
         Set symx = New SimpleFillSymbol
         symx.Style = esriSFSSolid
         symx.Outline.Width = 0.4
         Set pFeat = pFeatCursor.NextFeature
         Dim x As String
         x = pFeat.Value(iField) & pRender.FieldDelimiter & pFeat.Value(iField2) '*new Cory*       '<--変更（複数フィールドによる凡例表示用文字列）
         '** Test to see if we've already added this value
         '** to the renderer, if not, then add it.
         ValFound = False
         For uh = 0 To (pRender.ValueCount - 1)
           If pRender.Value(uh) = x Then
             NoValFound = True
             Exit For
           End If
         Next uh
         If Not ValFound Then
             pRender.AddValue x, strField1 & pRender.FieldDelimiter & strField2, symx              '<--変更（複数フィールドによる個別値を追加［カンマで区切る］）
             pRender.Label(x) = x
             pRender.Symbol(x) = symx
         End If
         i = i + 1
     Loop
      
     '** now that we know how many unique values there are
     '** we can size the color ramp and assign the colors.
     rx.size = pRender.ValueCount
     rx.CreateRamp (True)
     Dim RColors As IEnumColors, ny As Long
     Set RColors = rx.Colors
     RColors.Reset
     For ny = 0 To (pRender.ValueCount - 1)
         Dim xv As String
         xv = pRender.Value(ny)
         If xv <> "" Then
             Dim jsy As ISimpleFillSymbol
             Set jsy = pRender.Symbol(xv)
             jsy.Color = RColors.Next
             pRender.Symbol(xv) = jsy
         End If
     Next ny
  
     '** If you didn't use a color ramp that was predefined
     '** in a style, you need to use "Custom" here, otherwise
     '** use the name of the color ramp you chose.
     pRender.ColorScheme = "Custom"
     pRender.fieldType(0) = True
     Set pLyr.Renderer = pRender
     pLyr.DisplayField = strField1 
  
     '** This makes the layer properties symbology tab show
     '** show the correct interface.
     Dim hx As IRendererPropertyPage
     Set hx = New UniqueValuePropertyPage
     pLyr.RendererPropertyPageClassID = hx.ClassID
  
     '** Refresh the TOC
     pDoc.ActiveView.ContentsChanged
     pDoc.UpdateContents
      
     '** Draw the map
     pDoc.ActiveView.Refresh
      
End Sub