2013-06-30 130 views
1

最初我根據預定義的顏色主題改變餅圖的切片顏色在Excel VBA

Function GetColorScheme(i As Long) As String 
Const thmColor1 As String = "C:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\Blue Green.xml" 
Const thmColor2 As String = "C:\Program Files\Microsoft Office\Document Themes 14\Theme Colors\Orange Red.xml" 
    Select Case i Mod 2 
     Case 0 
      GetColorScheme = thmColor1 
     Case 1 
      GetColorScheme = thmColor2 
    End Select 
End Function 

然而寫從而改變了一系列餅圖的外觀的功能,路徑不是恆定的,我想要用rgb顏色自己定義每個餅圖切片。 我發現這裏的計算器一個previosu主題(How to use VBA to colour pie chart)的方式來改變餅圖

的每片的顏色,但我不knwo如何實現代碼放到上面提到的功能。我可能寫

Function GetColorScheme(i As Long) As String 

    Select Case i Mod 2 
     Case 0 
      Dim clr As Long, x As Long 

For x = 1 To 3 
    clr = RGB(0, x * 8, 0) 
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(x) 
     .Format.Fill.ForeColor.RGB = clr 
    End With 
Next x 
     Case 1 
      Dim clr As Long, x As Long 

For x = 1 To 3 
    clr = RGB(0, x * 8, 0) 
    With ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(x) 
     .Format.Fill.ForeColor.RGB = clr 
    End With 
Next x 
    End Select 
End Function 

功能鏈接到腳本的主要部分(這是)

For Each rngRow In Range("PieChartValues").Rows 
chtMarker.SeriesCollection(1).Values = rngRow 
ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor) 
chtMarker.Parent.CopyPicture xlScreen, xlPicture 
lngPointIndex = lngPointIndex + 1 
chtMain.SeriesCollection(1).Points(lngPointIndex).Paste 
thmColor = thmColor + 1 

其中線

ThisWorkbook.Theme.ThemeColorScheme.Load GetColorScheme(thmColor) 

獲取函數的值(查看代碼的第一位 - 原始函數),但現在我不再定義thmColor變量,也不知道如何最好地將代碼實現到函數部分

回答

1

像這樣的東西(你需要來調整顏色,以滿足您的需求)

http://www.rapidtables.com/web/color/RGB_Color.htm

Sub ApplyColorScheme(cht As Chart, i As Long) 

    Dim arrColors 

    Select Case i Mod 2 
     Case 0 
      arrColors = Array(RGB(50, 50, 50), _ 
           RGB(100, 100, 100), _ 
           RGB(200, 200, 200)) 
     Case 1 
      arrColors = Array(RGB(150, 50, 50), _ 
           RGB(150, 100, 100), _ 
           RGB(250, 200, 200)) 
    End Select 

    With cht.SeriesCollection(1) 
     .Points(1).Format.Fill.ForeColor.RGB = arrColors(0) 
     .Points(2).Format.Fill.ForeColor.RGB = arrColors(1) 
     .Points(3).Format.Fill.ForeColor.RGB = arrColors(2) 
    End With 

End Sub 

用法示例:

chtMarker.SeriesCollection(1).Values = rngRow 
ApplyColorScheme chtMarker, thmColor 
chtMarker.Parent.CopyPicture xlScreen, xlPicture