Raster-Render.zip_raster band render

Sub ChangeRenderToUVRenderer() On Error GoTo ERH Dim pMxDoc As IMxDocument Set pMxDoc = ThisDocument Dim pMap As IMap Set pMap = pMxDoc.FocusMap ' Get raster input from layer Dim pRLayer As IRasterLayer Set pRLayer = pMap.Layer(0) Dim pRaster As IRaster Set pRaster = pRLayer.Raster ' Get the number of rows from raster table Dim pTable As ITable Dim pBand As IRasterBand Dim pBandCol As IRasterBandCollection Set pBandCol = pRaster Set pBand = pBandCol.Item(0) Dim TableExist As Boolean pBand.HasTable TableExist If Not TableExist Then Exit Sub Set pTable = pBand.AttributeTable Dim NumOfValues As Integer NumOfValues = pTable.RowCount(Nothing) ' Specified a field and get the field index for the specified field to be rendered. Dim FieldIndex As Integer Dim FieldName As String FieldName = "Value" ' Value is the default field, you can specify other field here FieldIndex = pTable.FindField(FieldName) ' Create random color Dim pRamp As IRandomColorRamp Set pRamp = New RandomColorRamp pRamp.Size = NumOfValues pRamp.Seed = 100 pRamp.CreateRamp (True) Dim pFSymbol As ISimpleFillSymbol ' Create UniqueValue renderer and QI RasterRenderer Dim pUVRen As IRasterUniqueValueRenderer Set pUVRen = New RasterUniqueValueRenderer Dim pRasRen As IRasterRenderer Set pRasRen = pUVRen ' Connect the renderer and the raster Set pRasRen.Raster = pRaster pRasRen.Update ' Set UniqueValue renerer pUVRen.HeadingCount = 1 ' Use one heading pUVRen.Heading(0) = "All Data Values" pUVRen.ClassCount(0) = NumOfValues pUVRen.Field = FieldName Dim I As Long Dim pRow As IRow Dim LabelValue As Variant For I = 0 To NumOfValues - 1 Set pRow = pTable.GetRow(I) 'Get a row from the table LabelValue = pRow.Value(FieldIndex) pUVRen.AddValue 0, I, LabelValue 'Get a row from the table pUVRen.Label(0, I) = CStr(LabelValue) ' Set label Set pFSymbol = New SimpleFillSymbol pFSymbol.Color = pRamp.Color(I) pUVRen.Symbol(0, I) = pFSymbol 'Set symbol Next I 'Update render and refresh layer pRasRen.Update Set pRLayer.Renderer = pUVRen pMxDoc.ActiveView.Refresh pMxDoc.UpdateContents ' Clean up Set pMxDoc = Nothing Set pRLayer = Nothing Set pUVRen = Nothing Set pRasRen = Nothing Set pRamp = Nothing Set pFSymbol = Nothing Set pRaster = Nothing Set pRLayer = Nothing Set pMap = Nothing Set pBand = Nothing Set pBandCol = Nothing Set pTable = Nothing Set pRow = Nothing Exit Sub ERH: MsgBox Err.Description End Sub