[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『グラフのY軸を作成する順番を固定したい。』（ゲゲ）
既存のグラフのデータを削除したあとに2軸のグラフを作成するvbaコードが有る。
y軸をAxisgroupで決めた1、2つまり左、右の順番で作成してその次にデータを削除すると次に作成するときに右、左の順番でy軸が作成される。
それを常に左、右の順に作成して軸の位置を固定したい。
Sub グラフ作成()
' ワークシートの設定
Dim ws1 As Worksheet
Set ws1 = ThisWorkbook.Worksheets("A")
Dim ws2 As Worksheet
Set ws2 = ThisWorkbook.Worksheets("B")
Dim ws3 As Worksheet
Set ws3 = ThisWorkbook.Worksheets("C")
Dim ws4 As Worksheet
Set ws4 = ThisWorkbook.Worksheets("D")
' 変数の宣言
Dim i As Long, j As Long, k As Long, l As Long, m As Long, n As Long, o As Long, p As Long, q As Long
Dim number() As String
Dim number1 As Long
Dim Color(1 To 9) As Long ' 配列サイズを9に変更
Dim ChtObj As ChartObject
Dim cc As Long
'初期化
k = 0
l = ws1.Range("A:A").Find(What:=ws2.Range("AB2").Value, LookIn:=xlFormulas).Row
m = ws1.Range("A:A").Find(What:=ws2.Range("AB3").Value, LookIn:=xlFormulas).Row
' チャートオブジェクトが存在する場合のみ処理を実行
If ws2.ChartObjects.Count <> 0 Then
For i = 1 To ws2.ChartObjects.Count
Set ChtObj = ws2.ChartObjects(i)
ChtObj.Chart.ChartArea.ClearContents
number = Split(ws2.Cells(11, 27 + i), ",")
For n = 0 To UBound(number)
If number(n) <> "" Then
number1 = number(n) + 2
k = k + 1
cc = ws2.Cells(12 + n, 27 + i).Font.Color
Color(1) = cc Mod 256 ' 赤色
Color(2) = Int(cc / 256) Mod 256 ' 緑色
Color(3) = Int(cc / 256 / 256) ' 青色
With ChtObj.Chart.SeriesCollection.NewSeries
.AxisGroup = 1
.Name = ws1.Cells(3, number1) ' 系列名
.XValues = ws1.Range(ws1.Cells(l, 1), ws1.Cells(m, 1)) ' X値
.Values = ws1.Range(ws1.Cells(l, number1), ws1.Cells(m, number1)) ' Y値
.Format.Line.ForeColor.RGB = RGB(Color(1), Color(2), Color(3))
.ChartType = xlXYScatterLinesNoMarkers
End With
ChtObj.Chart.DisplayBlanksAs = xlInterpolated
ChtObj.Chart.PlotVisibleOnly = True
With ChtObj.Chart.Axes(xlCategory)
.MinimumScale = ws2.Range("AB2")
.MaximumScale = ws2.Range("AB3")
End With
End If
Next n
If ws2.Cells(27, 27 + i).Value <> 0 Then
Dim findResult As Range
Set findResult = ws3.Range(ws3.Cells(20, 1), ws3.Cells(36, 1)).Find(What:=ws2.Cells(27, 27 + i), LookIn:=xlValues)
If Not findResult Is Nothing Then
p = findResult.Row
Dim CC1 As Long, CC2 As Long, CC3 As Long
CC1 = ws2.Range("AB29").Font.Color
Color(1) = CC1 Mod 256 '赤色
Color(2) = Int(CC1 / 256) Mod 256 '緑色
Color(3) = Int(CC1 / 256 / 256) '青色
CC2 = ws2.Range("AB30").Font.Color
Color(4) = CC2 Mod 256 '赤色
Color(5) = Int(CC2 / 256) Mod 256 '緑色
Color(6) = Int(CC2 / 256 / 256) '青色
CC3 = ws2.Range("AB31").Font.Color
Color(7) = CC3 Mod 256 '赤色
Color(8) = Int(CC3 / 256) Mod 256 '緑色
Color(9) = Int(CC3 / 256 / 256) '青色
Set ChtObj = ws2.ChartObjects(i)
With ChtObj.Chart.SeriesCollection.NewSeries
.AxisGroup = 1
.ChartType = xlXYScatterLinesNoMarkers
.Name = ws3.Range("E20")
.XValues = ws3.Range(ws3.Cells(p, 3), ws3.Cells(p + 1, 3))
.Values = ws3.Range(ws3.Cells(p, 5), ws3.Cells(p + 1, 5))
.Format.Line.ForeColor.RGB = RGB(Color(1), Color(2), Color(3))
Select Case ws2.Cells(29, 27 + i).Value
Case "実線"
.Format.Line.DashStyle = msoLineSolid
Case "点線"
.Format.Line.DashStyle = msoLineDash
End Select
End With
With ChtObj.Chart.SeriesCollection.NewSeries
.AxisGroup = 1
.ChartType = xlXYScatterLinesNoMarkers
.Name = ws3.Range("F20")
.XValues = ws3.Range(ws3.Cells(p, 3), ws3.Cells(p + 1, 3))
.Values = ws3.Range(ws3.Cells(p, 6), ws3.Cells(p + 1, 6))
.Format.Line.ForeColor.RGB = RGB(Color(4), Color(5), Color(6))
Select Case ws2.Cells(30, 27 + i).Value
Case "実線"
.Format.Line.DashStyle = msoLineSolid
Case "点線"
.Format.Line.DashStyle = msoLineDash
End Select
End With
With ChtObj.Chart.SeriesCollection.NewSeries
.AxisGroup = 1
.ChartType = xlXYScatterLinesNoMarkers
.Name = ws3.Range("G20")
.XValues = ws3.Range(ws3.Cells(p, 3), ws3.Cells(p + 1, 3))
.Values = ws3.Range(ws3.Cells(p, 7), ws3.Cells(p + 1, 7))
.Format.Line.ForeColor.RGB = RGB(Color(7), Color(8), Color(9))
Select Case ws2.Cells(31, 27 + i).Value
Case "実線"
.Format.Line.DashStyle = msoLineSolid
Case "点線"
.Format.Line.DashStyle = msoLineDash
End Select
End With
End If
Else
End If
If ws2.Cells(32, 27 + i).Value <> 0 Then
Dim lastRow As Long
Set findResult1 = ws4.Range(ws4.Cells(1, 46), ws4.Cells(1, 69)).Find(What:=ws2.Cells(32, 27 + i).Value, LookIn:=xlValues)
If Not findResult1 Is Nothing Then
p = findResult1.Column
Dim CC4 As Long, CC5 As Long, CC6 As Long
CC4 = ws2.Range("AB34").Font.Color
Color(1) = CC4 Mod 256 '赤色
Color(2) = Int(CC4 / 256) Mod 256 '緑色
Color(3) = Int(CC4 / 256 / 256) '青色
CC5 = ws2.Range("AB35").Font.Color
Color(4) = CC5 Mod 256 '赤色
Color(5) = Int(CC5 / 256) Mod 256 '緑色
Color(6) = Int(CC5 / 256 / 256) '青色
CC6 = ws2.Range("AB36").Font.Color
Color(7) = CC6 Mod 256 '赤色
Color(8) = Int(CC6 / 256) Mod 256 '緑色
Color(9) = Int(CC6 / 256 / 256) '青色
With ws4
lastRow = .Cells(.Rows.Count, "AS").End(xlUp).Row
End With
Set ChtObj = ws2.ChartObjects(i)
With ChtObj.Chart.SeriesCollection.NewSeries
.AxisGroup = 2
.ChartType = xlXYScatterLinesNoMarkers
.Name = ws4.Range("AT2")
.XValues = ws4.Range(ws4.Cells(3, "AS"), ws4.Cells(lastRow, "AS"))
.Values = ws4.Range(ws4.Cells(3, p), ws4.Cells(lastRow, p))
.Format.Line.ForeColor.RGB = RGB(Color(1), Color(2), Color(3))
Select Case ws2.Cells(34, 27 + i).Value
Case "実線"
.Format.Line.DashStyle = msoLineSolid
Case "点線"
.Format.Line.DashStyle = msoLineDash
End Select
End With
With ChtObj.Chart.SeriesCollection.NewSeries
.AxisGroup = 2
.ChartType = xlXYScatterLinesNoMarkers
.Name = ws4.Range("AU2")
.XValues = ws4.Range(ws4.Cells(3, "AS"), ws4.Cells(lastRow, "AS"))
.Values = ws4.Range(ws4.Cells(3, p + 1), ws4.Cells(lastRow, p + 1))
.Format.Line.ForeColor.RGB = RGB(Color(4), Color(5), Color(6))
Select Case ws2.Cells(35, 27 + i).Value
Case "実線"
.Format.Line.DashStyle = msoLineSolid
Case "点線"
.Format.Line.DashStyle = msoLineDash
End Select
End With
With ChtObj.Chart.SeriesCollection.NewSeries
.AxisGroup = 2
.ChartType = xlXYScatterLinesNoMarkers
.Name = ws4.Range("AV2")
.XValues = ws4.Range(ws4.Cells(3, "AS"), ws4.Cells(lastRow, "AS"))
.Values = ws4.Range(ws4.Cells(3, p + 2), ws4.Cells(lastRow, p + 2))
.Format.Line.ForeColor.RGB = RGB(Color(7), Color(8), Color(9))
Select Case ws2.Cells(36, 27 + i).Value
Case "実線"
.Format.Line.DashStyle = msoLineSolid
Case "点線"
.Format.Line.DashStyle = msoLineDash
End Select
End With
End If
Else
End If
For Each ChtObj In ws2.ChartObjects
With ChtObj.Chart
With .Axes(xlCategory, xlPrimary)
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(200, 200, 200)
.MajorGridlines.Border.LineStyle = xlContinuous
End With
With .Axes(xlValue, xlPrimary)
.HasMajorGridlines = True
.MajorGridlines.Border.Color = RGB(200, 200, 200)
.MajorGridlines.Border.LineStyle = xlContinuous
End With
End With
Next ChtObj
Next i
End If
End Sub
＜ 使用 Excel：Excel2019、使用 OS：Windows11 ＞
勝手にしろ！！
それが人にものをお願いする態度か！
だらだらとコードを書きやがって、アホ！
（ゴン） 2023/12/20(水) 16:05:28
よくわかりませんが、 ChtObj.Chart.ChartArea.ClearContents の次に ChtObj.Chart.Axes(xlCategory).Crosses = xlAutomatic を挿入してみたらどうですか？
質問にあたって、回答者はあなたのシートが見えているわけではありません。 もう少し丁寧な説明をされたほうが回答が集まりやすいと思います。
（xyz） 2023/12/21(木) 06:49:50
> ChtObj.Chart.Axes(xlCategory).Crosses = xlAutomatic > を挿入してみたらどうですか？ に対する返事は無いのですか? （xyz） 2023/12/21(木) 12:01:54
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.