円グラフの色を一括してグランデーションに変更したい（要素を塗り分けて）

質問

エクセル2007を使用しています。
円グラフの色を要素を塗り分けたまま、一括してグランデーションに変更したいのです。
データ系列の書式設定で「塗りつぶし」の中で「要素を塗り分ける」にチェックを入れて、グランデーションにすると円グラフの色がすべて同じ色になってしまいます。
塗り分けて、一括してグランデーションにしたいのです。
よろしくお願いします。

回答No.1

xls88 · ベストアンサー

系列の要素ごとに書式設定をすることになります。
円をクリックすると系列が選択されます。
更に、ひとつの要素をクリックすれば、その要素が選択できます。
右クリックして、メニューの「データ要素の書式設定」から設定を行います。

試しにマクロを組んでみました。
一応、要素ごとにグラデーションが設定できたというレベルです。
対象グラフを選択しておいてからマクロを実行してください。

Sub test1()
Dim p As Point
Dim sc1
Dim sc2

sc1 = 25
sc2 = 45
For Each p In ActiveChart.SeriesCollection(1).Points
With p.Fill
.PresetGradient msoGradientDiagonalUp, 1, msoGradientDaybreak
.ForeColor.SchemeColor = sc1
.BackColor.SchemeColor = sc2
.TwoColorGradient 1, 1
End With
sc1 = sc1 + 1
sc2 = sc2 + 1
Next
End Sub

↓参考までに、テクスチャーの例です。

Sub test2()
Dim p As Point
Dim txture

For Each p In ActiveChart.SeriesCollection(1).Points
txture = txture + 1
p.Fill.PresetTextured (txture)
Next
End Sub

お礼

ご回答ありがとうございます。
ご提示いただいたマクロで対応できました。
お世話になりました。

回答No.5

xls88

こういう風でも出来ました。

For Each p In ActiveChart.SeriesCollection(1).Points
With p
.Interior.Color = .Interior.Color
.Format.Fill.Transparency = 0.5
End With
Next

お礼

度々のご回答ありがとうございます。
色々と勉強になりました。
お世話様でした。

回答No.4

xls88

＞色は変更しないで、一括して透過性を高くする（色を薄くする）ことは可能でしょうか？
透過性はTransparencyプロパティで設定します。
単色塗り潰しにしないと駄目なようです。
自動設定色を取得し塗りなおしています。

Dim p As Point
Dim pcol As Long

For Each p In ActiveChart.SeriesCollection(1).Points
With p
pcol = .Interior.Color
.Format.Fill.ForeColor.RGB = pcol
.Format.Fill.Transparency = 0.4
End With
Next

Transparencyプロパティのヘルプの抜粋です。
塗りつぶしの透明度を示す 0.0 (不透明) ～ 1.0 (透明) の値を設定します。

回答No.3

xls88

あと、コードで、変数sc1と変数sc2 で色を指定しています。
設定値を変えて試してみてください。
それから、Excell2007ではグラデーションの「方向」「角度」が設定出来ます。
残念ながらコードが分かりませんので手動で設定してみてください。

お礼

度々のご配慮ありがとうございます。
色は変更しないで、一括して透過性を高くする（色を薄くする）ことは可能でしょうか？
よろしくお願いします。

回答No.2

xls88

一色のグラデーションの場合です。

Sub test3()
Dim p As Point
Dim sc1 As Long
Dim idx As Long

sc1 = 25
For Each p In ActiveChart.SeriesCollection(1).Points
With p.Fill
.ForeColor.SchemeColor = sc1
.OneColorGradient 1, 1, 0.65
End With
sc1 = sc1 + 1
Next
ActiveCell.Activate
End Sub

回答番号：No.1で提示したコードで
.PresetGradient msoGradientDiagonalUp, 1, msoGradientDaybreak
は不要でした。

お礼

度々のご回答ありがとうございます。