[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『グラフのデータラベルについて』(しのみや)
【記述】 Selection.Format.Fill.ForeColor.RGB = RGB(255, 0, 0)
グラフの要素をクリックしてから、上記のマクロを実行すると 塗りつぶしの色が指定の色に設定されます。
【やりたいこと】 データラベルがグラフ要素の上に のっていた場合、 データラベルの文字色を白色に のっていない場合、データラベルの文字の色を黒色に と考えています。 (ひとまず円グラフと棒グラフ)
【質問】 グラフ要素の上にのっているかのっていないか、 の判断をする方法があるのでしょうか…。
< 使用 Excel:Excel2010、使用 OS:Windows10 >
遅くなりました。 まとめているうちに間に合わなかった様子です…
Positionプロパティで試してみます。
情報が足りずすみません。
グラフの要素を濃い色(たとえば黒色)で塗りつぶした場合に、 データラベルが標準の黒ですと同じ色になって確認ができないので、 塗りつぶす記述と同時に、白色にしてみたとします。
【記述】(円グラフの記述です) Dim Obj As Object Set Obj = Selection
Obj.Format.Fill.ForeColor.RGB = RGB(0, 0, 0)
ActiveChart.SeriesCollection(1).Points(Obj.DataLabel.Caption).DataLabel.Format. _ TextFrame2.TextRange.Font.Fill.ForeColor.ObjectThemeColor = 2
ここで要素にデータラベルがのっていれば、白で問題ないのですが、 要素にのっていない場合、白だとプロットエリアの白と重なり見えなくなります。
そちらを回避したいと思って、 データラベルが要素にのっていない場合は、黒色にできればと考えております。
「のっている」が、一部か全てについて、 一部でもグラフの要素にのっていれば データラベルの文字色を白色にする対応ができればと思っています。
このマクロの記述で要素の塗りつぶしを変えた場合のみの対応でして、 データラベルをクリックして要素の上から外した場合の動作は必要ないです。
(しのみや) 2021/01/08(金) 14:38
ごめんなさい。単なる感想です。^^; (承知の上でのチャレンジでしたら、無視して下さい)
要素の色が薄い色でも文字を白にしてしまっちゃう訳ですけど、 それって逆効果でないかなと...
要素のRGB値から輝度を算出して、 50%未満なら文字を白に、以上なら文字を黒に.. とかも出来なくはないですが、 そもそも > 一部でもグラフの要素にのっていれば > データラベルの文字色を白色にする ↑これ、 そうは言っても、文字以外の部分だけ要素と重なってて、 肝心の文字自体が外だったら、逆に文字見えなくなっちゃうんじゃないですか? ^^;
なんか「それ大丈夫?」感が見え隠れする仕様に思えて...
いっそ、データラベル塗っちゃった方が早くないですか? 例えば 塗りつぶしを白の単色で90%透過にして、光彩を白の3ptで60%透過、ぼかしも3pt で、文字自体は黒一色で統一。
とかにしちゃえば、 それほど主張の強いラベルにもならないでしょうし、 白背景に黒文字だから 要素と重なってようが、はみ出してようが、濃い薄いも関係なく 文字の見え易さは維持できると思うんですよね。(見栄えはさておき..)
一応、意見だけ。 失礼しました^^;
(白茶) 2021/01/08(金) 23:43
データラベルの「位置」のうち、棒の外にデータラベルが来るのは、 ・「外側上」(円グラフなら「外部」)を選択したとき ・他の内側の3つのオプションのどれかを選択したが、数値が小さいために、 データラベルがはみ出さざるを得ない時 ですよね。
既に白茶さんが指摘されているように、私も同様に、 データラベルの一部は棒と重なっていても、データラベルの文字列は棒の外にくることは 幾らでもあると思っていました。 そこを厳密に判定しようと努力しても、データラベルのフォントの大きさ、 データラベルの大きさ等に依存する複雑な、しかも近似的なものになるでしょう。 徒労に終わりそうです。
また、円グラフの場合は、判定の際の、相手の円グラフの一部は、扇状の図形であり、 それを含む最小矩形の位置が、top,left,width,heightでわかるだけです。 それとデータラベルの重なりを厳密に見ていくのは、徒労に終わりそうです。 (二つの矩形(つまり、データラベルと対応するデータ要素)の重なり判定は 勿論可能です。二つの重心間の距離(横方向、縦方向のそれぞれ)と、 それらの図形のwidth/2やheight/2 とを比較すればよいですが、 上記と同じ限界があります。)
私だったらこんな風にします。 ・「外側上」(円グラフであれば「外部」)以外はすべて、中にあるものと見なして いったんフォント色を白に変更します。 ・この中で、例外的にはみ出すものについては、「目視」で判定し、フォント色を元に戻します。 選択中の要素のフォント色をそれぞれ黒?にするマクロを、 クイックアクセスツールバーにでも登録しておいて、これを利用します。
例外的ケースを手作業で補うことも、ある意味で有益な手法だと思います。 場合によりけりです。複雑なコード作成に時間を費やすよりも、よほど省力化になると思います。
(参考までに) 2021/01/09(土) 06:45
単なる雑感です。
>【質問】 >グラフ要素の上にのっているかのっていないか、 >の判断をする方法があるのでしょうか…。
最終的には、そういう関数を作成するが目標でしょうが、
単にグラフといってもいろいろあります。
全部の種類に対応しようというのは無理があるように感じますし、
そもそも掲示板で解決できそうな話でもないような気がします。
それから、どんな人でも「こんな時はこうする。」と覚えている訳ではなく、
「こうやりたい」をその時々でどうやれば実現できるかを考えていく訳です。
なので、まずは、
グラフを限定し、1つについて深く掘り下げてみるところから、
始めてみてはいかがでしょ?
1つできれば応用でなんとかなるでしょう。
あと、画像とかで説明できると説明が楽になると思いません?
画像が楽に貼り付けられるサイトで質問してみてはいかがでしょう?
(まっつわん) 2021/01/09(土) 08:18
ひとまず円グラフで確認してみました。 円グラフを作り、Positionにあたるラベルの位置を確認してみたところ 初期値が自動調整になっており、 要素の割合によりグラフの内か外かが判別が付かない状態でした。
設定をしにいく項目であり、設定の状況を拾いに行くのは 難しいということかなぁと思っております…
top・height・left・widthは、たしかに位置は拾えて 対応できそうな気もしましたが、 現実的には難しいですね…さらに私の能力ではとても…
のっているかのっていないかの判別ができる項目があれば 判断できるかなぁと単純に思っておりましたが、なさそうですね。
対応方法として 「自動変更」のチェックボックスを作って、 チェックが入っているときはラベルの文字色を変更する 入っていないときは変更しない とします。
理解に時間がかかってしまいましたが… 参考までにさん 白茶さん まっつわんさん のおかげで勉強になりました。ありがとうございました。
(しのみや) 2021/01/12(火) 15:18
まっつあんさん 頭がいっぱいで回答が抜けておりました
>画像が楽に貼り付けられるサイトで質問してみてはいかがでしょう? 仰る通りだと思います
ただ社内で書き込んでおりまして、セキュリティの関係で 確認できるページが制御されていたり、 ファイルを貼り付ける等が制限されていると思います (しのみや) 2021/01/12(火) 15:57
Sub DataLabel_iti() Dim Sh As Shape Dim n As Integer, Sc As Integer Dim c As Object, a As Object Dim DtLabel As Variant, Pt As Variant Dim CAx As Double, CAy As Double, CAr As Double
Set Sh = ActiveSheet.Shapes("グラフ 1") With Sh Debug.Print "ShapArea 上:"; .Top; " 左:"; .Left; " 縦:"; .Height; " 横:"; .Width Set a = .Chart Debug.Print "ChartArea 上:"; a.ChartArea.Top; " 左:"; a.ChartArea.Left; " 縦:"; a.ChartArea.Height; " 横:"; a.ChartArea.Width Debug.Print "ChartPlotArea 上:"; a.PlotArea.Top; " 左:"; a.PlotArea.Left; " 縦:"; a.PlotArea.Height; " 横:"; a.PlotArea.Width Debug.Print "ChartType"; a.ChartType
'プロットエリアに円が接しているとして CAx = a.PlotArea.Left + a.PlotArea.Height / 2 '円センター座標_X CAy = a.PlotArea.Top + a.PlotArea.Width / 2 '円センター座標_Y CAr = a.PlotArea.Height / 2 '円の半径
Sc = 1 For Each c In a.FullSeriesCollection With c Debug.Print Sc, .ChartType Select Case .ChartType Case xlPie '円 n = 1 For Each Pt In .Points If Pt.HasDataLabel = True Then With Pt Debug.Print n; "> 値"; .DataLabel.Text 'グラフ Debug.Print "グラフ塗Type:"; .Fill.Type Debug.Print "扇色 :"; .Fill.ForeColor.RGB 'ラベル With .DataLabel With .Format Debug.Print "ラベル字色 :"; .TextFrame2.TextRange.Font.Fill.ForeColor.RGB End With 'ラベル位置 Dim tPx As Double, tPy As Double, tR As Double Select Case .Position Case xlLabelPositionBestFit If CAx > .Left Then tPx = .Left - CAx ' .Width Else tPx = CAx - .Left ' .Width End If If CAy > .Top Then tPy = CAy - .Top '' .Height Else tPy = .Top - CAy ' .Height End If tR = Sqr(tPx ^ 2 + tPy ^ 2) '円センターから.Topまでの距離 If CAr < tR Then Debug.Print "自円外" Else Debug.Print "自円内" End If Case xlLabelPositionInsideEnd Debug.Print "手円内" Case xlLabelPositionOutsideEnd Debug.Print "手円内外" Case xlLabelPositionCenter Debug.Print "手円中央" End Select End With End With n = n + 1 End If Next Case Else
End Select End With Sc = Sc + 1 Next End With End Sub (ふむ〜) 2021/01/12(火) 17:26
案としては、データラベルの中心点が円の中かどうかで判定したらどうですか?
棒グラフの場合も、中心点が対応するPointの長方形の中にあるかどうかで判定すればよさそうですね。
(γ) 2021/01/12(火) 21:18
言葉だけだとアレなのでコードを作ってみました。参考までに。 (ふむ〜さんのコードを全面的にお借りしました。)
棒グラフの場合、棒の横幅以上の桁数があると判読不能になるし、 問題は残っていますね。 ・円グラフはデータラベルの中心が、円内にあるかどうかで判定 ・棒グラフは、データラベルの高さの1/4以上、上にあれば外と判定。(置きの前提) Sub dataLabel_coloring() Dim ch As Chart Dim ser As Series Dim pt As Point Dim centerX As Double, centerY As Double, radius As Double
Set ch = ActiveChart '簡易な指定方法にしています■要修正かも Select Case ch.ChartType Case xlPie With ch.PlotArea centerX = .Left + 0.5 * .Width centerY = .Top + 0.5 * .Height radius = 0.5 * .Height End With 'For Each ser In ch.FullSeriesCollection '■↓で動かなければ修正ください For Each ser In ch.SeriesCollection 'Excel2010にはこれしかない For Each pt In ser.Points Call colorSub1(pt, centerX, centerY, radius) Next Next Case xlColumnClustered '集合縦棒 For Each ser In ch.SeriesCollection For Each pt In ser.Points Call colorSub2(pt) Next Next Case Else MsgBox "未対応" End Select End Sub
'データラベルのフォント色をセット Function setColor(pt As Point, myColor As Long) pt.DataLabel.Format.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = myColor End Function
'円グラフのデータラベルフォントの色づけ Function colorSub1(pt As Point, centerX#, centerY#, radius#) Dim diffX#, diffY#, diff#
If pt.HasDataLabel = False Then Exit Function With pt.DataLabel Select Case .Position Case xlLabelPositionBestFit '自動調整 diffX = Abs(.Left + 0.5 * .Width - centerX) 'dataRabelの中心と円の中心との差 diffY = Abs(.Top + 0.5 * .Height - centerY) diff = Sqr(diffX ^ 2 + diffY ^ 2) If radius < diff Then '外側と判断 setColor pt, vbBlack Else setColor pt, vbWhite End If Case xlLabelPositionInsideEnd, xlLabelPositionCenter '内部外側と中央 setColor pt, vbWhite Case xlLabelPositionOutsideEnd '外部" setColor pt, vbBlack End Select End With End Function
'縦棒グラフのデータラベルフォントの色づけ Function colorSub2(pt As Point) If pt.HasDataLabel = False Then Exit Function With pt.DataLabel Select Case .Position Case xlLabelPositionOutsideEnd setColor pt, vbBlack Case Else If (.Top + 0.25 * .Height) < pt.Top Then '1/4以上はみ出していれば外と判断 setColor pt, vbBlack Else setColor pt, vbWhite End If End Select End With End Function 18:55 ミス修正 (γ) 2021/01/14(木) 13:08
ありがとうございます。 探究心がすごいです。(語彙力なくてすみません) 手持ちの仕事であたふたしておりましてちょっと先になりそうですが、 勉強させて頂きます。 わからない点などが出てくると思いますので、また教えて頂けると助かります。 (しのみや) 2021/01/14(木) 16:36
> データラベルがグラフ要素の上に > のっていた場合、 データラベルの文字色を白色に > のっていない場合、データラベルの文字の色を黒色に > と考えています。 > (ひとまず円グラフと棒グラフ)
円グラフでやってみました。
「データラベルの4つの角のうち、2点以上が円の外なら内側でないと判定」
(手動で移動してあるというのは想定外とします。)
という風にやってみました。参考になれば。
Sub test()
Dim Cht As Chart Dim Srs As Series Dim Pit As Point Dim X As Double Dim Y As Double Dim R As Double
Set Cht = Sheets(1).ChartObjects(1).Chart Set Srs = Cht.SeriesCollection(1) R = Cht.PlotArea.Width / 2
For Each Pit In Srs.Points With Pit X = .PieSliceLocation(xlHorizontalCoordinate, xlCenterPoint) Y = .PieSliceLocation(xlVerticalCoordinate, xlCenterPoint) .DataLabel.Format.TextFrame2.TextRange.Font.Fill.ForeColor _ .RGB = IIf(chkInSide(.DataLabel, X, Y, R), vbWhite, vbBlack) End With Next End Sub
Function chkInSide(ByRef lbl As DataLabel, _
ByVal X As Double, _ ByVal Y As Double, _ ByVal R As Double) As Boolean Dim v(3, 1) As Double Dim i As Long, k As Long With lbl v(0, 0) = .Left v(0, 1) = .Top v(1, 0) = .Left + .Width v(1, 1) = .Top v(2, 0) = .Left + .Width v(2, 1) = .Top + .Height v(3, 0) = .Left v(3, 1) = .Top + .Height End With
For i = 0 To 3 If R < Sqr((X - v(i, 0)) ^ 2 + (Y - v(i, 1)) ^ 2) Then k = k + 1 End If If k > 1 Then Exit Function Next
chkInSide = True End Function
円の中心の座標は変わらないのでループの外で取得した方がよいかと思いますが、
それっぽいプロパティを探す元気がないので、この辺でギブアップです。
(まっつわん) 2021/01/15(金) 10:24
動作を勉強させてもらっておりましてハテナな部分をまとめておりましたが、 質問以前のそもそもの知識が足りておらず… そんな中、基礎的な勉強ができそうな本を入手しましたので、 そちらで勉強してからにします。 また教えていただけると助かります。
ありがとうございます。 (しのみや) 2021/01/15(金) 10:42
ひとまず(γ)さんの記述から勉強させて頂いており… 必要な動作は得られております。ありがとうございます。
グラフの要素を選択してから実行した場合、 選択されている要素のみのデータラベルのフォントの色が変わるようにしたくて、 以下のように、SeriesとPointに分けるところまではできたのですが、
(円グラフのみの記述にしています) Sub test()
Dim ch As Chart Dim ser As Series Dim pt As Point Dim centerX As Double Dim centerY As Double Dim radius As Double
Dim obj As Object
Set obj = Selection Set ch = ActiveChart
With ch.PlotArea centerX = .Left + 0.5 * .Width centerY = .Top + 0.5 * .Height radius = 0.5 * .Height End With
Select Case TypeName(obj) Case "Series" For Each ser In ch.SeriesCollection For Each pt In ser.Points Call colorSub1(pt, centerX, centerY, radius) Next Next Case "Point" '選択されている要素のみのデータラベルのフォントを変える
End Select End Sub
Pointの場合、どの要素が選択されており その要素にラベルが表示されているのかの判断の仕方がわかりません。 https://excel-ubara.com/EXCEL/EXCEL916.html#sec07 このページを勉強をしておりますが、いまいち解決までいけません…
どのようにすればよいでしょうか (しのみや) 2021/01/19(火) 15:43
Sub test002() Dim ch As Chart Dim pt As Point Dim centerX As Double Dim centerY As Double Dim radius As Double
If TypeName(Selection) = "Point" Then Set pt = Selection Else Exit Sub End If
centerX = pt.PieSliceLocation(xlHorizontalCoordinate, xlCenterPoint) centerY = pt.PieSliceLocation(xlVerticalCoordinate, xlCenterPoint) Set ch = pt.Parent.Parent.Parent.Parent radius = ch.PlotArea.Height * 0.5
colorSub1 pt, centerX, centerY, radius End Sub
こんなんで分かりますでしょうか?
>このページを勉強をしておりますが、いまいち解決までいけません…
用語を理解せずに読んでもわからないでしょうね。
オブジェクト
プロパティ
メソッド
ステートメント
コレクション
この辺の用語を理解されてますか?
>For Each pt In ser.Points
↑この行を日本語に翻訳できますか?
(まっつわん) 2021/01/19(火) 16:40
オブジェクトモデル
クラス
なども理解されておくと、ヘルプの内容もだいぶ読めるようになると思います。
(まっつわん) 2021/01/19(火) 16:48
動作確認ありがとうございました。 すでにコメントいただいているので、船頭多くなるかもですが、少しだけ。
グラフは特に、多くのオブジェクトが階層構造を持ってつながっていて、 それぞれの部品の内容をざっと理解しておくことが欠かせません。
一般的な話として、 結果としてのコードだけ見ていてはイメージが湧きにくいよくあることで、 概要がわかったら、ステップ実行して、途中段階でそれぞれのオブジェクトがどんな プロパティを持っているかを ・ローカルウインドウで確認したり ・イミディエイトウインドウに出力して確認する ことは、とても有益です。
そのためには、ふむ〜さん が提示されているコードはうってつけの好材料だと思います。 結果に至るまでの検討・調査も見せてくれています。是非、そちらを検討してみて下さい。
本で抽象的なことを学ぶことも大切ですが、身近な素材で具体的に確認して、 いわば身体感覚を高めていくこともコードを書く上で欠かせない気がします。 コードが書けるということはそういうことかと愚考します。
# 有名な数学者ガウスは常々、「建物が完成したあかつきは、足場を見せてはいけない」と # 周りに言っていたそうです。我々も、結果としての構築物だけでなく、 # その足場を想像しながら追体験するようなことができれば、理解も深まるような気がします。
(γ) 2021/01/19(火) 17:27
ありがとうございます。 教えていただいたことから勉強してみます。 用語とふむ〜さんの記述ですね。 また行き詰ると思いますので教えていただけると助かります。 (しのみや) 2021/01/20(水) 09:06
べた並べですが、動作確認願います。
Sub test()
Dim ch As Chart Dim ser As Series Dim pt As Point Dim centerX As Double Dim centerY As Double Dim radius As Double Dim obj As Object Dim a As String Dim b As Variant
Set obj = Selection Set ch = ActiveChart With ch.PlotArea centerX = .Left + 0.5 * .Width centerY = .Top + 0.5 * .Height radius = 0.5 * .Height End With Select Case TypeName(obj) Case "PlotArea" 'プロットエリア '単データ列or複データ列or円 すべての系統、Point For Each ser In ch.SeriesCollection For Each pt In ser.Points Call colorSub1(pt, centerX, centerY, radius) Next Next Case "Series" Select Case obj.ChartType Case xlPie '円 すべて For Each ser In ch.SeriesCollection For Each pt In ser.Points Call colorSub1(pt, centerX, centerY, radius) Next Next Case xlColumnClustered '集合縦棒 Debug.Print "Obj.Name>>"; obj.Name Debug.Print "Obj.Type>>"; obj.Type Debug.Print "Obj.Parent.Type>>"; obj.Parent.Type a = Replace(Replace(obj.Formula, "=SERIES(", ""), ")", "") b = Split(a, ",") Debug.Print b(0) If b(0) = "" Then '複データ列の系統名(複データ列の1つの系統) For Each ser In ch.SeriesCollection If ser.Name = obj.Name Then For Each pt In ser.Points Call colorSub2(pt) Next End If Next Else '単データ列なら項目名(単データ列のPoint) For Each ser In ch.SeriesCollection If ser.Name = obj.Name Then For Each pt In ser.Points Call colorSub2(pt) Next End If Next End If End Select
Case "Point" '選択されている要素のみのデータラベルのフォントを変える Select Case obj.Parent.ChartType Case xlPie '円 Call colorSub1(obj, centerX, centerY, radius) Case xlColumnClustered '集合縦棒(複データ列のPoint) Call colorSub2(obj) End Select End Select End Sub (ふむ〜) 2021/01/21(木) 22:28
ありがとうございます。 勉強させて頂きます。 (しのみや) 2021/01/22(金) 09:11
すみません ひとつ教えてください。
Function colorSub1(pt As Point, centerX#, centerY#, radius#) Dim diffX#, diffY#, diff#
ここの#はなんのためにつけているのでしょうか? (しのみや) 2021/01/25(月) 10:08
ああ、それは型宣言文字というものです。 VBAのヘルプから引用 | 型宣言文字 | 変数、定数、関数名の末尾に付ける、データ型を示す文字。 | 型宣言文字などを使って、明示的にデータ型を指定しなかったときは、 | 変数のデータ型は、既定のバリアント型 (Variant) になります。 | ただし、Deftype ステートメントの対象となっているときはその既定のデータ型になります。
# は、Doubleの型宣言文字なので、 Dim diffX# は、 Dim diffX As Double と書くのとまったく同じです。
このほか、以下があります。 & Long の型宣言文字 $ String の型宣言文字 % Integerの型宣言文字 ! Single の型宣言文字
VBAのヘルプに載っているので、正式のものですが、 質問掲示板では余り使われませんね。(説明が必要になるので) 私は、省力化もあって、一時的な個人用コードでは使います(&,#,$くらいかな)が、 今回はうっかりです。 (γ) 2021/01/25(月) 11:09
ご丁寧に教えてくださりありがとうございます。 理解できました。
頑張ります。 (しのみや) 2021/01/25(月) 12:10
縦棒グラフのデータラベルフォントの色づけのファンクションについて 頂いた記述からPosisitonのところを自分が理解できるようにさせてもらいました。
次に横棒の場合も追加してみようとしておりまして、 以下のようにしておりました。
'縦横棒グラフのデータラベルフォントの色づけ Function ColorSub2(pt As Point, StrChtType As String) If pt.HasDataLabel = False Then Exit Function With pt.DataLabel Select Case .Position Case -4108, 3, 4 '●-4108:中央 3:内側上 4:内側軸寄り Fn_SetColor pt, vbWhite Case 2 '●2:外側上 Fn_SetColor pt, vbBlack Case 7 '●7:手動 Select Case StrChtType '縦棒グラフ Case 51, 52, 53, 54, 55, 56, -4100, 92, 93, 94, 98, 99, 100, 101, 105, 106, 107, 108, 112 If (.Top + 0.25 * .Height) < pt.Top Then '1/4以上はみ出していれば外と判断 Fn_SetColor pt, vbBlack Else Fn_SetColor pt, vbWhite End If '横棒グラフ Case 57, 58, 59, 60, 61, 62, 95, 96, 97, 102, 103, 104, 109, 110, 111 '(省略 )
ファンクション(ColorSub2)の中にStrChtTypeを渡して縦グラフか横グラフか判断をしていますが、 ファンクションに入る前に(dataLabel_coloringの中で)判断したほうが良いのかな?とも思います…
そうすると、dataLabel_coloringの中でPosisitonが手動の場合に…という判断が必要になってくるかと思いまして dataLabel_coloringでもPosisitonの判断をして、ColorSub2の中でもPosisitonの判断が必要になります…
必要な動作はするのですが、なんだかもやもやして良くないのではないかと悩んでいます。 どのようにしたらよいでしょうか。 (しのみや) 2021/02/08(月) 14:15
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.