[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『グラフに、上限値２本と下限値２本追加したい』（ポム）
グラフに、上限下限を表す線を追加したいのですが
データ部分は、データテーブルを表示しているので
グラフに入れ込もうとすると上限下限値まで表示されて
しまいます。
上限下限値は、右に凡例表示だけで良いのですが罫線で書くと
ズレてしまい編集も大変です。
グラフは３００近くあるのですが何か良い方法あれば
教えて下さい。
＜ 使用 Excel：Excel2013、使用 OS：Windows10 ＞
データテーブルを使うと、すべての系列を表示してしまうので、 単なる系列追加ではNGということなんでしょうか？
図形をグラフに追加するということなんでしょうか。 一応、プロトタイプは書いてみましたが、まだ完成とまではいきません。
そのまえに前提の確認です。 (Q1)グラフの種類はどのようなものですか？ (Q2)組み合わせグラフなどはありますか？ (Q3)２軸を使ったグラフはありますか？
(Q4)上限値、下限値などの指定はどのようにする積りでしょうか？ シート上に指定を書き込むとしたら、どのようなデータになりますか？ 例を挙げてください。 （γ） 2022/06/10(金) 18:11
単なる系列追加ではNGということなんでしょうか？ → はい、そうなんです。
(Q1)グラフの種類はどのようなものですか？ →折れ線グラフが、4本から成っているグラフです。 (Q2)組み合わせグラフなどはありますか？ →ありません。 (Q3)２軸を使ったグラフはありますか？ →使ってないですね。
(Q4)上限値、下限値などの指定はどのようにする積りでしょうか？ →グラフを、選択して図形で罫線を引こうかなと作業始めたの ですが意外と大変でした… マイテンプレートの適用が何故か出来なくなっていて割当てが 出来ないので１つ１つ変更してます。 現在のグラフは、+3〜-3なのでそれを+10〜-10に変更しそこに グラフ内に、図形で線を計4本引いています。
シート上に指定を書き込むとしたら、どのようなデータになりますか？
+8,-8と+10,-10
データ数は、1つのグラフに対して1ヶ月分の日数でそれが月60〜80件
くらい
宜しくお願いします。
工事が、終わるまでずっーと続く作業で過去分を変更しています。
宜しくお願いします。
（ポム） 2022/06/10(金) 22:17
再度修正しました。(6/12)
・現在アクティブなブックの、アクティブシートのすべてのグラフについて、 上限下限の直線を書き込みます。 ・とりあえず、基準値は 10, 8, -8, -10 にしてあります。 ・標準モジュールにコピーペイストして "基準値の書き込み"プロシージャを 実行してください。
不測の事態への責任は負えませんので、バックアップを取っておくことを推奨します。
【参考コード】
Sub 基準値の書き込み()
Dim 基準値配列 As Variant
Dim 基準値 As Variant
Dim ch As Chart
Dim pa As PlotArea
Dim yAxis As Axis
Dim minY#, maxY#
Dim l#, t#, w#, h#
Dim posY#(1 To 4)
Dim k As Long, j As Long
基準値配列 = Array(10, 8, -8, -10) '■テスト用
For k = 1 To ActiveSheet.ChartObjects.Count
Set ch = ActiveSheet.ChartObjects(k).Chart
With ch
Call deleteShape(ch) '■■既に書き込まれている図形を削除
Set yAxis = .Axes(xlValue)
minY = yAxis.MinimumScale '縦軸の最小値
maxY = yAxis.MaximumScale '縦軸の最大値
'■基準値が、現在の縦軸の最大最小から外れる場合は処理終了
For Each 基準値 In 基準値配列
If 基準値 > maxY Or 基準値 < minY Then
MsgBox ch.Name & " について、" _
& vbLf & "基準値の指定が、現在の軸の上下限(" & "(" & minY & "," & maxY & ") を超えています。" _
& vbLf & "処理を終了します"
Exit Sub
End If
Next
'プロットエリアの位置情報
With .PlotArea
l = .InsideLeft
t = .InsideTop
w = .InsideWidth
h = .InsideHeight
End With
'基準値に対応する位置に線を引く
For j = 1 To UBound(基準値配列) + 1
posY(j) = t + (maxY - 基準値配列(j - 1)) / (maxY - minY) * h
With .Shapes.AddLine(l, posY(j), l + w, posY(j)).Line
.Weight = 2# '■線の太さ
.DashStyle = msoLineSysDash '■線の種類
.ForeColor.RGB = vbRed '■色
.Visible = msoTrue
End With
Next
End With
Next
End Sub
Function deleteShape(ch As Chart)
Dim sp As Shape
For Each sp In ch.Shapes
sp.Delete
Next
End Function
ちなみに、当初使っていた https://excel-ubara.com/excelvba5/EXCELVBA241.html は、データテーブルを使っていたり、縦棒グラフに対しては、 位置がおかしくなるので注意が必要です。
・直接、図形描画したので、コードもスッキリしました。やはり借り物はいけない。 ・ちなみに、グラフを移動しても、書き込んだ直線は追随して移動しますが、 グラフを拡大縮小すると崩れます。再実行してください。
（γ） 2022/06/11(土) 00:02
ありがとうございます。
月曜日まで、確認が出来ないのが申し訳ないのですが 出勤しだいすぐにやってみます。
宜しくお願いします。 （ポム） 2022/06/11(土) 06:02
私は以下のようにして水平線を引いています。 参考にしてください。
棒グラフと折れ線グラフに水平線を引く方法
STEP1）元となるデータに基準値を設定する 基準線を引くには、その他のデータと同じように、基準値も設定してあげる必要があります。 基準線を水平線にしたい場合、目標値は全て同じ値にしてください。 水平線を引きたい分だけ、目標値を設定する。
|[A] |[B] |[C] |[D] |[E] |[F] |[G] [1]| |１月|２月|３月|４月|５月| [2]|売上 |1000| 810|1200| 700| 800| [3]|目標値| 800| 800| 800| 800| 800| ← 基準線とするデータ 基準線とするデータはユーザー定義「;;;」で非表示にするとよいでしょう。
STEP2）基準値のグラフの種類を「折れ線」にする 折れ線グラフは「その他の折れ線グラフ」をクリックして水平線が入ったグラフを選択します。 棒グラフは「組み合わせ」を選択し、「集合縦棒−折れ線」を選択します。 これで基準線が引けました。
STEP3）基準線が短いのを長くする方法 基準線が引けたのはいいのですが左右に余白が出ています。 基準線をクリックして選択状態にし、右クリックで「近似曲線の追加」を選択します。 「近似曲線の書式設定」が表示されるので、「予測」の項目の「前方補外」と「後方補外」にそれぞれ 「0.5」と入力します。 このままでは伸びた分の線だけ点線になってしまっているので、線種を変えます。 「近似曲線の書式設定」から「塗りつぶしと線」を選択し、「実線/点線」で一番上の実線を選択します。 元の線と伸びた分の線の幅が微妙に違うので、「幅」を「2.25pt」にして元の線の幅に合わせます。
STEP4）凡例「線形」を削除 「線形(◯◯)」と凡例が追加されるので削除します。 凡例全体をを選択して「線形(◯◯)」をクリックし「Delete」キーで削除します。
STEP5）これで完成です。 （nm） 2022/06/11(土) 23:46
（γ） 2022/06/11(土) 23:50
ありがとうございます。
動いたのですが、-3〜+3のところについては処理がされず
また、-10と+10、-8と+8で罫線の色と線種を変えたいです。
簡単に、設定変更できますか?
（ポム） 2022/06/13(月) 10:20
また、-3〜+3の目盛になっているところをシート内全て
マクロの記録で、グラフの番号を一回一回変更しながら
は手間だなあーと。
全てのグラフに、実行するにはどうすれば良いのか
教えて下さい。
（ポム） 2022/06/13(月) 11:34
修正点
(1)軸の最大最小
・縦軸の最小値が-10より大きかったら、-10まで引き下げる。
・縦軸の最大値が 10より小さかったら、 10まで引き上げる。
(2)色 （少し違うかもしれないが、その場合はご自分で修正してください。）
(3)線種
メインのプロシージャーだけ示します。
Sub 基準値の書き込み()
Dim 基準値配列 As Variant
Dim 基準値 As Variant
Dim 色配列 As Variant
Dim 線種配列 As Variant
Dim ch As Chart
Dim pa As PlotArea
Dim yAxis As Axis
Dim minY#, maxY#
Dim l#, t#, w#, h#
Dim posY#(1 To 4)
Dim k As Long, j As Long
基準値配列 = Array(10, 8, -8, -10) '■
色配列 = Array(RGB(247, 150, 70), RGB(75, 172, 198), RGB(75, 172, 198), RGB(247, 150, 70)) '■変更
線種配列 = Array(msoLineSolid, msoLineSolid, msoLineSysDash, msoLineSysDash) '■変更
For k = 1 To ActiveSheet.ChartObjects.Count
Set ch = ActiveSheet.ChartObjects(k).Chart
With ch
Call deleteShape(ch) '■■既に書き込まれている図形を削除
Set yAxis = .Axes(xlValue)
minY = yAxis.MinimumScale '縦軸の最小値
maxY = yAxis.MaximumScale '縦軸の最大値
'■■縦軸の最大最小を修正■■
If minY > -10 Then
yAxis.MinimumScale = -10
minY = -10
End If
If maxY < 10 Then
yAxis.MaximumScale = 10
maxY = 10
End If
'プロットエリアの位置情報
With .PlotArea
l = .InsideLeft
t = .InsideTop
w = .InsideWidth
h = .InsideHeight
End With
'基準値に対応する位置に線を引く
For j = 1 To UBound(基準値配列) + 1
posY(j) = t + (maxY - 基準値配列(j - 1)) / (maxY - minY) * h
With .Shapes.AddLine(l, posY(j), l + w, posY(j)).Line
.Weight = 2# '■線の太さ
.DashStyle = 線種配列(j - 1) '■線の種類 ■変更
.ForeColor.RGB = 色配列(j - 1) '■色 ■変更
.Visible = msoTrue
End With
Next
End With
Next
End Sub
なお、コメントを下さっている方に、きちんと返事をしてください。 （γ） 2022/06/13(月) 12:26
ありがとうございます。
そのやり方は、やってはみたのですがデータテーブルに
表示されてしまうため担当者からも却下されました…
追伸
いつもは、このやり方でした。
（ポム） 2022/06/13(月) 12:35
ありがとうございます。
線種と目盛の変更一括で、出来ました。
ただ、なぜかマイナスラインが、ズレてしまいます。
軸の最大値を変更したときに、
いったん修正した最小値が再度動いてしまうのですかね。
再現できるデータを示してもらえますか。
もしくは、
手で最大値、最小値を変更してから、実行して切り抜けられませんか？
（γ） 2022/06/13(月) 13:40
結構、予測しないことがおきますね。 ＞いったん修正した最小値が再度動いてしまうのですかね。 だったようです。
下記の最後の2行を足してみて下さい。
'■■縦軸の最大最小を修正■■
If minY > -10 Then
yAxis.MinimumScale = -10
minY = -10
End If
If maxY < 10 Then
yAxis.MaximumScale = 10
maxY = 10
End If
minY = yAxis.MinimumScale '縦軸の最小値 ’★追加
maxY = yAxis.MaximumScale '縦軸の最大値 ’★追加
（γ） 2022/06/13(月) 14:19
こうだったかもしれません。まだつぶし切れていないかもしれません。
'■■縦軸の最大最小を修正■■
If minY > -10 Then
yAxis.MinimumScale = -10
End If
If yAxis.MaximumScale < 10 Then
yAxis.MaximumScale = 10
End If
minY = yAxis.MinimumScale '縦軸の最小値
maxY = yAxis.MaximumScale '縦軸の最大値
（γ） 2022/06/13(月) 14:31
これは、修正前のコードで実行した分です。
（ポム） 2022/06/13(月) 14:58
身も蓋もないんで憚られる事ではありますが... (もう、あえて言っちゃういます ^^; )
広く意見を募れば「データテーブル辞めればいいじゃん」って考える人も こういう場合ある程度の割合で存在すると思うんですよね。
グラフエリア・プロットエリアの両方を「枠なし」「塗りなし」にしてグラフをテーブル(セル範囲)側に溶け込ませる とか、 「リンクされた図」をデータテーブルの代わりにグラフに(ちょい)重ねて配置する とか。
そういったデザイン的な路線変更が可能であれば、案外サクっと解決するかも知れませんね。 (ま、たぶんそれが許されないから困ってらっしゃるんだとは思うんですけど...)
（白茶） 2022/06/13(月) 15:31
>>基準線とするデータはユーザー定義「;;;」で非表示にするとよいでしょう。 これやってみましたか。 データテーブル自体は空白になります。 ただシートと違って行列の削除はできないみたいです。 これも却下されるんでしょうね。 （nm） 2022/06/13(月) 16:10
そうですね。
今のフォーマットで、決定してしまったので上の決定なので
担当者にも変更権限がなく…
nm 様
そうなんです。
それも、やってみて枠は出てしまうので却下と…
グラフ内に、図形で罫線描くってことになりました。
そもそも、そういうので描いたものはズレてしまいますよね。
（ポム） 2022/06/13(月) 18:15
For j = 1 To UBound(基準値配列) + 1
posY(j) = t + (maxY - 基準値配列(j - 1)) / (maxY - minY) * h
With .Shapes.AddLine(l, posY(j), l + w, posY(j)).Line
.Weight = 2# '■線の太さ
.DashStyle = 線種配列(j - 1) '■線の種類 ■変更
.ForeColor.RGB = 色配列(j - 1) '■色 ■変更
.Visible = msoTrue
End With
ズレてしまうので変更するならここかなと思って (maxY - （minY-6)) * h と、してみたらエクセル上では-6と-8の位置にありますが出力するといい位置に きたのですが上の8と10はmaxYをいくら変えても下がって来てくれない のです。数値にして1くらい上へいっているので下げたいのです。 どこを調整すれば良いか教えて下さい。 （ポム） 2022/06/13(月) 18:22
これで試してみてください。
Sub 基準値の書き込み()
Dim 基準値配列 As Variant
Dim 基準値 As Variant
Dim 色配列 As Variant
Dim 線種配列 As Variant
Dim ch As Chart
Dim pa As PlotArea
Dim yAxis As Axis
Dim minY#, maxY#
Dim v#
Dim l#, t#, w#, h#
Dim posY#(1 To 4)
Dim k As Long, j As Long
基準値配列 = Array(10, 8, -8, -10) '■
''''基準値配列 = Array(20, 16, -16, -20) '■
色配列 = Array(RGB(247, 150, 70), RGB(75, 172, 198), _
RGB(75, 172, 198), RGB(247, 150, 70)) '■変更
線種配列 = Array(msoLineSolid, msoLineSolid, _
msoLineSysDash, msoLineSysDash) '■変更
For k = 1 To ActiveSheet.ChartObjects.Count
Set ch = ActiveSheet.ChartObjects(k).Chart
With ch
Call deleteShape(ch) '■既に書き込まれている図形を削除
'■■縦軸の最大最小を修正■■
Set yAxis = .Axes(xlValue)
With yAxis
.MinimumScaleIsAuto = True '自動に戻す
.MaximumScaleIsAuto = True
minY = .MinimumScale '縦軸の最小値
maxY = .MaximumScale '縦軸の最大値
'最大値から調節開始
v = 基準値配列(0)
If maxY < v Then
.MaximumScale = v
End If
.MaximumScaleIsAuto = False '自動を無効化
v = 基準値配列(3)
If .MinimumScale > v Then
.MinimumScale = v
End If
.MinimumScaleIsAuto = False '自動を無効化
minY = .MinimumScale '縦軸の最小値
maxY = .MaximumScale '縦軸の最大値
End With
'プロットエリアの位置情報
With .PlotArea
l = .InsideLeft
t = .InsideTop
w = .InsideWidth
h = .InsideHeight
End With
'基準値に対応する位置に線を引く
For j = 1 To UBound(基準値配列) + 1
posY(j) = t + (maxY - 基準値配列(j - 1)) / (maxY - minY) * h
With .Shapes.AddLine(l, posY(j), l + w, posY(j)).Line
.Weight = 2# '■線の太さ
.DashStyle = 線種配列(j - 1) '■線の種類
.ForeColor.RGB = 色配列(j - 1) '■色
.Visible = msoTrue
End With
Next
End With
Next
End Sub
Function deleteShape(ch As Chart)
Dim sp As Shape
For Each sp In ch.Shapes
sp.Delete
Next
End Function
（γ） 2022/06/13(月) 20:45
>グラフ内に、図形で罫線描くってことになりました。 これを今マクロで罫線を描いているところですよね。 ところでグラフが拡大縮小されたとき罫線も一緒に拡大縮小してくれますか。 またグラフを移動した時も一緒に移動してくれますか。 クラフと罫線をグループ化できないんですけど。 この辺についてはどうなんでしょうか。 （nm） 2022/06/14(火) 09:10
| ・ちなみに、グラフを移動しても、書き込んだ直線は追随して移動しますが、
| グラフを拡大縮小すると崩れます。再実行してください。
|（γ） 2022/06/11(土) 00:02
このため、実行にあたって、常に既存の図形をいったん削除したうえで、
そののちに図形を再追加させる仕様にしています。
また、繰り返しせずに、
・Set ch = ActiveChart
すれば、現在アクティブなグラフに限定して処理が可能です。
加えて、簡単なコード追加で、
アクティブなブック内の各シートの各グラフに一括処理させることもできますね。
（γ） 2022/06/14(火) 09:20
グラフを、選択した状態で図形を追加すると動かないみたいです。
選択せずに、直接描くとグラフを動かしたり拡大縮小しても
ついてきてくれないみたいです。
（ポム） 2022/06/14(火) 12:49
どのイベントが適切か判断できませんが とりあえず Deactivateイベントを使ってみました。 Calculateイベントも必要か？ https://docs.microsoft.com/ja-jp/office/vba/excel/concepts/events-worksheetfunctions-shapes/chart-object-events 適切なタイミングで、「イベントON」マクロを実行します。 例えば、ブックOPEN時に。 うざいようであれば、「イベントOFF」を実行です。
'--- クラスモジュール Class1 ----- Option Explicit
Public WithEvents myChart As Chart
Private Sub myChart_Deactivate()
基準値の書き込み
End Sub
'--- 標準モジュール Module1 ----- Option Explicit
Dim cht() As New Class1
Sub イベントON()
Dim cho As ChartObject
Dim k As Long
For Each cho In Worksheets("Sheet1").ChartObjects '★実際のシート名に変更
k = k + 1
ReDim Preserve cht(1 To k)
Set cht(k).myChart = cho.Chart
Next
End Sub
Sub イベントOFF()
Dim k As Long
On Error Resume Next
For k = 1 To UBound(cht)
Set cht(k).myChart = Nothing
Next
End Sub
（マナ） 2022/06/14(火) 16:16
ありがとうございます。
エクセルデータ上では、問題ないのですがやはり印刷すると
ズレてしまう事象は変わりなかったので
t + (maxY - 基準値配列(j - 1)) / (maxY - minY) * h
で、足したり、引いたりする数値を追記してみたらエクセル上では
違う場所に罫線がありますが印刷するとぴったり合うようになりま
した。
明日、担当者に見てもらい凡例をどのように入れるか等聞こうと
思ってます。
マナ 様
ありがとうございます。
Deactivateイベント等、初めて聞く言葉なのですが勉強の為、
やってみたいと思います。
（ポム） 2022/06/14(火) 18:41
「画面上では正確に表示されるようになりました」という発言は 2022/06/14(火) 18:41より前には、どこにもなかったように思います。 「画面上ではOkだが、印刷したときにずれてしまう」と正確に書いていただきたかったですね。
私の手元で印刷してみましたが、正確に印刷されました。 プリンタとの関係もありますし、環境依存の話なのでしょう。 ですから、あなた以外のかたが実行または印刷した場合にどうなるか、 別の結果になる可能性もありますよ。
一案ですが、 ・グラフを選択して「図としてコピー」し ・適切な位置に「図（拡張メタファイル）」として貼り付けます。 これで印刷してもズレないようになりませんか？
また、こうして得られた図形は、移動も拡大縮小も問題なくできるはずです。 メタファイルなので、拡大しても画像の精度は余り落ちないはずです。 図になりますから、むろんデータの変更には追随しませんが。
マクロ記録取れば、コードは得られます。トライされたらいかがですか？
私はいったんここで区切りとさせていただきます。
（γ） 2022/06/15(水) 06:47
>印刷するとズレてしまう 私の場合は印刷プレビューで確認したところ マイナス線だけが両方とも下方へ下がっています。 基準値配列のマイナス値を減少して合わせました。 >エクセル上では違う場所に罫線がありますが これは同じです。 却下されなければいいですけどね。 >印刷するとぴったり合うようになりました。 最終的には印刷目的だったのでしょうか。 （nm） 2022/06/15(水) 11:54
昨日、担当者に書き置きと出力した紙を置いて帰りました。
今日は、バタバタしていて話す時間がなかったので
明日まで保留となりました。
でも、最終的にはDocuWorksかPDFになると思います。
（ポム） 2022/06/15(水) 18:36
分かりづらい文章すいませんでした。
ずっと、書いているつもりでした。
今現在は、アドインを設定して実行しているので
私以外は、実行出来ないと思います。
ただ、今までもエクセル内で図形を描いてずれなかった
ことがないのでズレるものって思っていましたが
ズレずに出力出来ると聞いてびっくりしています。
（ポム） 2022/06/15(水) 18:50
「MSPゴシック」ではズレました。
「游ゴシック」ではズレませんでした。
（マナ） 2022/06/15(水) 20:39
（マナ） 2022/06/15(水) 20:42
＞「MSPゴシック」ではズレました。
確認できました。
私のは「游ゴシック」が設定されていました。
なお、ズレる「MSPゴシック」でも、既に書いたように、
「図としてコピー」「メタファイルで貼り付け」した図形を印刷すると
ズレずに印刷されました。あくまで、私の環境ですけど。
（γ） 2022/06/15(水) 22:07
確認ありがとうございます。
フォントを、確認してみます。
「図としてコピー」「メタファイルで貼り付け」した図形を印刷すると
→ はい、やってみました。ズレずに印刷出来ました。
とりあえず、フォントを確認して変更してみます。
また、報告します。 宜しくお願いします。 （ポム） 2022/06/16(木) 07:47
別の原因が、あるのかもしれません。
（ポム） 2022/06/16(木) 12:27
ブック（あるいはシート）を新規に作らないと
既存シートのフォント変更ではだめですよ。
（マナ） 2022/06/16(木) 12:50
Excelの「オプション」で設定変更します。下記、参照。
http://www4.synapse.ne.jp/yone/excel/excel_syosiki_font1.html
設定変更してから、新しいブックを作成すれば、その既定フォントが
変わっているはずです。
（γ） 2022/06/16(木) 17:05
ありがとうございます。
新規ブックを、開き規定フォントをゆうゴシックへ変更し
再起動してから、シートコピーでコピーしたのですが
フォントは、元のMSPゴシックとなってしまうようです。
でも、ズレてはいないようにも思えます。
ファイル自体のフォントが、変更されるわけではないので
しょうか?
コピーしたら、コピーしたシートもフォントが変わるのかなと
思ったので。
2016だと、規定フォントに変わると書いてあったのですが。
（ポム） 2022/06/16(木) 18:28
（マナ） 2022/06/16(木) 18:56
再現ありがとうございます。
シートコピーだけでいいんですね。
ありがとうございます。
はい、解決しました!
また、宜しくお願いします。
（ポム） 2022/06/16(木) 21:19
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.