問題:
如果讓圓餅圖的標籤底色固定,當標籤變動時底色也跟著移動
例如狀況一「橡皮擦」的底色已固定為紅色,但使用狀況二排序數字後,橡皮擦標籤底色變為橘色,而到狀況三排序數字後,橡皮擦標籤底色則變為藍色。但希望無論狀況一~三,都能固定橡皮擦的底色為紅色
範例檔
https://drive.google.com/file/d/11bdhBKiV9K8YusWbCMmtIbBBx1V5hBKS/view?usp=sharing
改版如下
「將工作表中的顏色設定給圖表中對應的區塊」
(注意:排序儲存格時只有資料會移位,顏色不會)
Sub MainRun()
Dim MyColor
Dim sLabel
For nR = 2 To 7
'1.取得顏色
sLabel = Range("A" & nR).Value
MyColor = Range("A" & nR).Interior.ColorIndex
'2.設定顏色
ActiveSheet.ChartObjects("圖表 1").Activate
For nI = 1 To 6
ActiveChart.SeriesCollection(1).Points(nI).Select
If (Left(Selection.DataLabel.Text, Len(sLabel)) = sLabel) Then
Selection.Interior.ColorIndex = MyColor
End If
Next
Next
End Sub
PieChart本身就有圖例和標籤
如果你堅持要自己畫標籤
我只會用VBA這麼做
1.資料排序
2.執行VBA替儲存格上色
結果如下圖
如果符合要求的話
再去看VBA原始碼
Sub MainRun()
Dim MyColor
'1.取得顏色
ActiveSheet.ChartObjects("圖表 1").Activate
For nI = 1 To 6
ActiveChart.SeriesCollection(1).Points(nI).Select
Debug.Print nI & "[" & Selection.DataLabel.Text & "]"
If (Left(Selection.DataLabel.Text, 3) = "橡皮擦") Then
MyColor = Selection.Interior.ColorIndex
End If
Next
'2.設定儲存格
For nR = 2 To 7
If Range("A" & nR).Value = "橡皮擦" Then
Range("A" & nR).Interior.ColorIndex = MyColor
End If
Next
End Sub
海大~剛測試一下好像有點FU了,但~~~好像反了耶!哈~
我是希望用儲存格標籤的底色,套用到圖表標籤的底色
例如我的範別,我已經設定好儲存格B3:B8的名稱及底色,然後我希望套用到圓餅圖上,無論B3:B8怎麼排序變動,圓餅圖的標籤底色都能跟B3:B8的儲存格標籤底色一樣,醬你聽得懂嗎?哈~
那就反過來寫,我稍後改一下 VBA
哈這也太難了啦對我而言,不過目前的VBA範例是只有單一橡皮擦,可以再麻煩幫我試寫所有的顏色對應嗎~超級感謝的唷~
msmplayv121068
VBA 已修改供參考
C大~依不同狀況執行三次結果如上,好像圓餅圖顏色沒辦法準確與儲存格底色完成相同,但我不確定是不是我OFFICE版本的問題會嗎?我是OFFICE2010~
檔案如下,可以再麻煩您有空幫我瞧瞧為何嗎?非常感謝~~
https://drive.google.com/file/d/14rOPcwVflz7PQGhHiqBciMNgVw20Wd-H/view?usp=sharing
先確認兩件事:
1.各儲存格裡的文字(例:手機)前後沒有其他字元(例:換列)
2.C大是誰?
1.目前的 VBA 已可文字長短不固定
2.看起來似乎是「手機」和「橡皮擦」這兩項沒有設定顏色,試著換個文字試試看(手機改成手機王,橡皮擦改成立可白)
要就全部成功,要就全部失敗
這種部份成功的情形
通常是資料的原因
海大~測試結果調整文字狀況仍相同,發現只有電腦和鍵盤顏色相近但仍不相同,其他顏色均不相同
真的蠻怪的...
我用 Excel 2003 測試過,全部都正常
稍後我再去用 Excel 2019 測試看看
可惜我沒有 Excel 2020 可以測試(我不認為是版本的原因)
哇海大你也太好心了吧~超感謝耶
我是2010的唷~~~~
換成 2019 才發現
1.排序時除了「資料」,連「顏色」也會跟著移動
2.因為第一點緣故,故 VBA 只要執行一次即可
3.這次再不行的話,只好另請高明
修改VBA如下
Sub MainRun()
Dim MyColor
Dim sLabel
For nR = 2 To 7
'1.取得顏色
sLabel = Range("A" & nR).Value
MyColor = Range("A" & nR).Interior.Color
'2.設定顏色
ActiveSheet.ChartObjects("圖表 1").Activate
For nI = 1 To 6
ActiveChart.FullSeriesCollection(1).Points(nI).Select
If (Left(Selection.DataLabel.Text, Len(sLabel)) = sLabel) Then
Selection.Format.Fill.ForeColor.RGB = MyColor
End If
Next
Next
End Sub
海大測試真的成功了耶!!!這就是我所需要的,你真是太厲害了
不過中間有一段「ActiveChart.FullSeriesCollection(1).Points(nI).Select」我把Full拿掉才能執行喔~~~~
再次感謝無私幫忙耶非常感謝~~~
問題解決就好
由於沒有範例,我是用變更色彩來做,但沒法判斷排列位址,只能人工調整。