Question

我正在尝试仪表板/等值线。我从here.

下载了欧洲版

我会保持简单，我想做的第一件事就是改变灰色和黑色。蓝色。谁能帮忙？模板附带的代码位于

之下

Option Explicit

Function udf_RGB(myR As Byte, myG As Byte, myB As Byte) As Long

  udf_RGB = RGB(myR, myG, myB)

End Function

Sub CheckColor(myCell As Range, myNameToShape As String, myValueToColor As String)
Dim myShape As Shape
Dim myTargetCell As Range
Dim myColorCode As Long

On Error GoTo Catch
  Set myTargetCell = Range(myNameToShape).Columns(1).Find(myCell.Name.Name, LookAt:=xlWhole)
  Set myShape = Sheets(1).Shapes(myTargetCell.Offset(0, 1))
  GoTo Finally

Catch:
  Exit Sub
Finally:

  On Error GoTo 0

  If myCell.Value < Range(myValueToColor).Cells(2, 1).Value Then
    myColorCode = Range(myValueToColor).Cells(1, 2).Value
  Else
    myColorCode = Application.WorksheetFunction.VLookup(myCell.Value, Range(myValueToColor), 2, True)
  End If

  myShape.Fill.ForeColor.RGB = myColorCode

End Sub

Sub UpdateMap()
Dim myCell As Range

  Application.ScreenUpdating = False

  For Each myCell In Range("MapNameToShape").Columns(1).Cells
     CheckColor Range(myCell.Value), "MapNameToShape", "MapValueToColor"
  Next myCell

  Application.ScreenUpdating = True

End Sub

Answer 1

一种廉价的方式，但如果你改变这一行

udf_RGB = RGB(myR, myG, myB)

到

udf_RGB = RGB(myR, myG, 255)

它将用蓝色代替黑色。

等值线，颜色和数据

1 个答案: