Excelのグラフで近似曲線を透明化すると凡例の幅が自動調整されてしまう

Question

前提・実現したいこと

未だ研究室に属していない学生の身分ですのでレポート作成においてグラフを描画するには専らExcelを用いています．科学的なグラフではデータの位置を表すプロットの上を線が通るか通らないかということは大きな意味を持ちます．プロットより表面に線が来ていれば，それはそのプロットを確実に線が通っているということを意味し，逆に線がプロットの背面であればプロットを通っているとは言えず，近似的な意味を持ちます．しかし，Excelの近似曲線では系列より表面に描画されてしまい，"近似"ではなくなってしまいます．近似式を取得して近似曲線の系列を作り，マーカーなしにしてマーカー同士を結べば元のデータ系列のマーカー背面に位置させることができますが，科学実験で得られるデータは不規則なことやデータ間が広いことがしばしばあり，結ばれる線がヨレヨレに見えることがあります．理論的には近似曲線の系列を十分に細かくとってやれば滑らかに見えますが，どんな場合でも滑らかに見えるような区切り方となると無限に細かくせざるを得ません．当然そんなことをすればExcelもPCも悲鳴をあげます．そこで白抜きにしたいグラフを複製し，片方をマーカーのみ，もう片方をマーカー以外見えるようにして背景の塗りつぶしを無くしてぴったり重ねる方法を取ります．ぴったり重ねるにはグラフシートにマーカー以外を表示しているグラフを移動させ，そこにオブジェクトとしてマーカーのみのグラフを移動させて，最大化しています．
Rなら白抜きプロットは簡単にできるのですが，細かな体裁の調整はExcelの方が簡易で，VBAのコードもほぼ完成に近いためこのままExcelで成し遂げたいと思います．

発生している問題・エラーメッセージ

実は上記の手法をVBAで書くことは下記のコードでほぼ達成されています．現在問題となっているのは2つ以上の系列に近似曲線を描画し，凡例をグラフに重ねずに付けた上で下記のコードを実行すると，重ね合わせるグラフがずれてしまうことです．

原因はマーカーのみ表示のグラフの方で近似曲線を透明化して凡例に表示されている近似曲線も透明化された際，Excelが要らぬ気を利かせて凡例の幅を自動調整し，結果としてプロットエリアの幅が広くなり，マーカー以外表示のグラフとずれてしまうことです．「近似曲線を透明化しても凡例の近似曲線はそのまま」や「凡例の自動調整を無効にする」などこの問題の解決に妙案ありましたらご教授頂けますでしょうか．

該当のソースコード

Option Explicit
Sub Macro1()
Dim PlotCha As ChartObject
Dim LineCha As ChartObject
Dim OriginSh As Worksheet
Dim LineName As String
'On Error Resume Next
    Set LineCha = ActiveChart.Parent
    LineName = LineCha.Name
    Set OriginSh = ActiveSheet
    If LineCha Is Nothing Then
        MsgBox "白抜きプロットにするグラフを選んでから実行してください．", Title:="手順ミス"
        Exit Sub
    End If
    LineCha.Chart.ChartArea.Copy
    Range("A1").Select
'Application.ScreenUpdating = False
    OriginSh.Paste
    Set PlotCha = Selection.Parent.Parent
Dim PlotName As String
    PlotName = LineName & "Copy"
    PlotCha.Name = PlotName
    With OriginSh.Shapes(LineName)
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
    End With
    With LineCha.Chart
Dim i As Long
        For i = 1 To .FullSeriesCollection.Count
            .FullSeriesCollection(i).MarkerStyle = xlMarkerStyleNone
        Next i
Dim ChartSh As String
        ChartSh = "Sheet_" & LineName
        .Location xlLocationAsNewSheet, Name:=ChartSh
    End With
    With OriginSh.Shapes(PlotName)
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
    End With
    With PlotCha.Chart
        .ChartArea.Format.TextFrame2.TextRange.Font.Fill.Transparency = 1
        With .Axes(xlCategory)
            .MajorGridlines.Format.Line.Visible = msoFalse
            With .Format
                .Line.Visible = msoFalse
                .Fill.Visible = msoFalse
            End With
        End With
        With .Axes(xlValue)
            .MajorGridlines.Format.Line.Visible = msoFalse
            With .Format
                .Line.Visible = msoFalse
                .Fill.Visible = msoFalse
            End With
        End With
Dim j As Long
        For j = 1 To .FullSeriesCollection.Count
            With .FullSeriesCollection(j)
Dim k As Long
                For k = 1 To .Trendlines.Count
                    .Trendlines(k).Format.Line.Visible = msoFalse
                Next k
            End With
            .FullSeriesCollection(j).Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        Next j
        .Location xlLocationAsObject, Name:=ChartSh
    End With
    With Sheets(ChartSh).Shapes(PlotName)
        .ScaleWidth 2.0341434821, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 2.2135414844, msoFalse, msoScaleFromTopLeft
        'マクロの記録で得られた値ですが，この数値で良いのか，また，そもそもメソッドとして最大化の（マーカー以外表示グラフのサイズに合わせる）方法はないのか思案中です．
    End With
    ActiveChart.ChartArea.Copy
    OriginSh.Pictures.Paste.Select
'Application.ScreenUpdating = True
End Sub

試したこと

凡例をグラフに重ねて表示しているものに上記コードを実行するとずれることはありません．また，凡例をグラフに重ねずに表示しているものに上記コードを実行後，グラフシートに作成されたマーカーのみのグラフの幅を少し狭めるとマーカーが正しい位置に来る点があります．これらのことから，やはり凡例の幅が縮まったことによってプロットエリアの幅が広くなり，重ねた際のズレを生み出していると考えられます．実際，適当なグラフを作って凡例をグラフに重ねずに表示し，近似曲線を手動で透明化するとプロットエリアが広くなる様子が見て取れます．

補足情報（FW/ツールのバージョンなど）

PC
MacBook Air，Intel Core i5-5250U，Boot CampによりWindows 10 Homeにて運用
Excel
2016 32ビット，バージョンは最新の状態

###追記1
回答を受けまして，「変更点」と示した部分に設定された色を取得して再設定するコードを付加しました．2020年8月25日17時01分

Option Explicit
Sub Macro1()
Dim PlotCha As ChartObject
Dim LineCha As ChartObject
Dim OriginSh As Worksheet
Dim LineName As String
'On Error Resume Next
    Set LineCha = ActiveChart.Parent
    LineName = LineCha.Name
    Set OriginSh = ActiveSheet
    If LineCha Is Nothing Then
        MsgBox "白抜きプロットにするグラフを選んでから実行してください．", Title:="手順ミス"
        Exit Sub
    End If
    LineCha.Chart.ChartArea.Copy
    Range("A1").Select
'Application.ScreenUpdating = False
    OriginSh.Paste
    Set PlotCha = Selection.Parent.Parent
Dim PlotName As String
    PlotName = LineName & "Copy"
    PlotCha.Name = PlotName
    With OriginSh.Shapes(LineName)
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
    End With
    With LineCha.Chart
Dim i As Long
        For i = 1 To .FullSeriesCollection.Count
            .FullSeriesCollection(i).MarkerStyle = xlMarkerStyleNone
        Next i
Dim ChartSh As String
        ChartSh = "Sheet_" & LineName
        .Location xlLocationAsNewSheet, Name:=ChartSh
    End With
    With OriginSh.Shapes(PlotName)
        .Fill.Visible = msoFalse
        .Line.Visible = msoFalse
    End With
    With PlotCha.Chart
        .ChartArea.Format.TextFrame2.TextRange.Font.Fill.Transparency = 0.99
        With .Axes(xlCategory)
            .MajorGridlines.Format.Line.Visible = msoFalse
            With .Format
                .Line.Visible = msoFalse
                .Fill.Visible = msoFalse
            End With
        End With
        With .Axes(xlValue)
            .MajorGridlines.Format.Line.Visible = msoFalse
            With .Format
                .Line.Visible = msoFalse
                .Fill.Visible = msoFalse
            End With
        End With
Dim j As Long
        For j = 1 To .FullSeriesCollection.Count
            With .FullSeriesCollection(j)
Dim k As Long
                For k = 1 To .Trendlines.Count
                    With .Trendlines(k).Format.Line
Dim LineCol As Variant
                        LineCol = .ForeColor
                        .ForeColor.RGB = RGB(LineCol Mod 256, Int(LineCol / 256) Mod 256, Int(LineCol / 256 / 256)) '変更点
                        .Transparency = 0.99
                    End With
                Next k
            End With
            .FullSeriesCollection(j).Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
        Next j
        .Location xlLocationAsObject, Name:=ChartSh
    End With
    With Sheets(ChartSh).Shapes(PlotName)
        .ScaleWidth 2.0341434821, msoFalse, msoScaleFromTopLeft
        .ScaleHeight 2.2135414844, msoFalse, msoScaleFromTopLeft
    End With
    ActiveChart.ChartArea.Copy
    OriginSh.Pictures.Paste.Select
'Application.ScreenUpdating = True
End Sub

###追記2
実際のグラフは動作確認用ですが以下のような感じです．2020年8月25日17時14分
データ

マクロ実行前に選択されるグラフ

実行後にグラフシートにて背面に来るグラフ（マーカー以外表示グラフ）

実行後にグラフシートにて表面に来るグラフ（マーカーのみ表示グラフ）
実行前グラフの近似曲線の色を取得して，同色を単色として再設定し，透明度99%に設定

グラフシートにて重なった2つのグラフ

###追記3
追記1の通り一応望むものはごり押しでできました．今暫く回答受付中にしますので，これよりスマートな記述法がありましたらご教授願います．これが最適である場合にはその旨を教えて下さると幸いです．2020年8月25日17時18分
###追記4
追記2にて重なったグラフ（完成グラフ）を載せるのを忘れていましたので修正しました．2020年8月25日17時22分

Comments

[radames1000]

実際のグラフを提示していただけませんか？

[stdio]

少し理由が分からない点があります。
何故透過する必要があるのでしょうか？
表とグラフのシート分けるとかで工夫出来ますよね...

[sinzou]

一つのグラフをコピーして重ねるのでしたら、
同じデーターで２系列かいて、その内一つを処理る？　ではダメですか

https://docs.microsoft.com/ja-jp/office/vba/api/excel.series.plotorder
データ系列のプロット順序を設定

[zzzTKG]

遅ればせながら実際のグラフを掲載しました．失礼しました．

[zzzTKG]

追記2をご覧頂くとお分かりになるかと思われますが，上から重ねるため透過しなければ結局マーカーの上に線が見えてしまうのです．グラフ画像不備により混乱を招いてしまい，すみません．

[zzzTKG]

それは前提欄にも記しました通り，近似曲線の式を取得して，近似曲線をデータ系列として作成して，近似曲線系列の上にデータ系列を持ってくる方法ですね．この方法は近似曲線系列が型崩れする場合があり，実用的ではありませんでした．
また，変えられるのは系列同士の前後関係のみであり，近似曲線は常に全ての系列の上に表示されてしまいますので，近似曲線を近似曲線として白抜きプロットを作るためには2つのグラフを重ねるより他にないと考えられます．

[jinoji]

凡例があるからずれるのだとすれば、凡例なしにしてしまえば、とか思ってしまうのは罪深き文系脳の性。
凡例なしグラフの重ね合わせの裏に、凡例のみのグラフを更に重ねる、とか考えたけど、全くスマートじゃないですね・・・

[zzzTKG]

前者はやはりデータを分かりやすく提示することが目的であるグラフとしては避けたいですね．
後者ですが，凡例を入れる領域を凡例なしペアの方でズレなく空けられればいいのですが，グラフの式や軸ラベルなどの処理を考えると遠回りになるような気もします．スッキリとこれらを管理できれば有効な手法ではありそうです．

Answer 1

大分放置してしまいました...
追記3にお示しして以後，ご回答やご返信現れませんでしたので，追記1に示したコードにて自己解決と致します．
原因は凡例の線色がデフォルトでは自動設定であり，このまま透明度をいじると自動から単色に切り替わることで線の描画にズレが生じるようです．対策として，自動設定の色を取得し，単色として再設定することで自動調整を失くしました．
皆様ご助言ありがとうございました．

Answer 2

（修正、載せ替え）

Sub tes01()

Dim shName(2) As String, shpName
Dim j, col, AreaWidth, AreaHeight
Dim PlotAreaTop, PlotAreaLeft, PlotAreaWidth, PlotAreaHeight

    With ActiveSheet.Shapes.AddChart.Chart
        '.ChartType = xlXYScatter '分布図
        .ChartType = xlLine '折れ線
        
      .SeriesCollection.NewSeries
        With .FullSeriesCollection(1)
            .Name = "=Sheet2!$B$1"
            .XValues = "=Sheet2!$A$2:$A$16"
            .Values = "=Sheet2!$B$2:$B$16"
            .MarkerStyle = 8
            .MarkerSize = 5
            .MarkerBackgroundColorIndex = 2
            
        End With
    
        .SeriesCollection.NewSeries
        With .FullSeriesCollection(2)
            .Name = "=Sheet2!$D$1"
            .XValues = "=Sheet2!$A$2:$A$16"
            .Values = "=Sheet2!$D$2:$D$16"
            .MarkerStyle = 8
            .MarkerSize = 5
            .MarkerBackgroundColorIndex = 2
        End With
        .HasLegend = False
    End With
    shName(0) = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name
      
    'グラフの複写
    shName(0) = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name
    ActiveSheet.Shapes(shName(0)).Copy
    Range("F38").Select
    ActiveSheet.Paste
    shName(2) = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name
    
    '系統文字列変更、追加
    With ActiveSheet.Shapes(shName(0))
        For j = 1 To .Chart.FullSeriesCollection.Count
            With .Chart.FullSeriesCollection(j)
                .Name = "系統" & j 
                .Trendlines.Add Type:=xlLinear, Forward:=0, Backward:=0, _
                    DisplayEquation:=0, DisplayRSquared:=0, Name:="線形 (系統" & j & ")"
                    
                col = .Format.Line.ForeColor
                With .Trendlines(1)
                    With .Format.Line
                        .Visible = msoTrue
                        .ForeColor.RGB = col
                        .DashStyle = msoLineSysDash
                        .Transparency = 0.4
                    End With
              
                End With
                With .Trendlines(1)
                    .DisplayEquation = True
                    .DisplayRSquared = True
                End With
            End With
        Next
        .Top = Range("F5").Top
        .Left = Range("F5").Left
        .Height = 300
        .Width = 400
    End With
    'グラフの複写
    ActiveSheet.Shapes(shName(0)).Copy
    Range("F20").Select
    ActiveSheet.Paste
    shName(1) = ActiveSheet.Shapes(ActiveSheet.Shapes.Count).Name
    
    
'shName(0)
    With ActiveSheet.Shapes(shName(0)).Chart
        .HasLegend = True
        For j = 1 To .FullSeriesCollection.Count
            
            With .FullSeriesCollection(j)
                With .Format.Line
                    col = .ForeColor
                    .ForeColor.RGB = msoThemeColorBackground1
                    .Transparency = 1
                End With
               '.MarkerBackgroundColor = msoThemeColorBackground1
                .MarkerForegroundColor = col
            End With
        Next
    End With
 
'shName(1)
    With ActiveSheet.Shapes(shName(1)).Chart
       For j = 1 To .FullSeriesCollection.Count
            With .FullSeriesCollection(j)
                .Format.Line.ForeColor.RGB = RGB(255, 255, 255)
                .MarkerBackgroundColor = RGB(255, 255, 255)
                .MarkerForegroundColor = RGB(255, 255, 255)
            End With
        Next
        With .ChartArea
            .Fill.Visible = msoFalse
            .Format.Line.Visible = msoFalse
        End With
        With .PlotArea
            .Format.Fill.Visible = msoTrue
            .Format.Line.Visible = msoFalse
        End With
        With .Axes(xlValue)
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0
                .Transparency = 1
            End With
        End With
        With .Axes(xlCategory)
            With .Format.Line
                .Visible = msoTrue
                .ForeColor.ObjectThemeColor = msoThemeColorBackground1
                .ForeColor.TintAndShade = 0
                .ForeColor.Brightness = 0
                .Transparency = 1
            End With
        End With
        
        
    End With

    
'shName(2)の加工
    With ActiveSheet.Shapes(shName(2)).Chart
        For j = 1 To .FullSeriesCollection.Count
            With .FullSeriesCollection(j)
                With .Format.Line
                    col = .ForeColor
                    .ForeColor.RGB = msoThemeColorBackground1
                    .Transparency = 1
                End With
               '.MarkerBackgroundColor = msoThemeColorBackground1
                .MarkerForegroundColor = col
            End With
        Next
        With .ChartArea
            .Fill.Visible = msoFalse
            .Format.Line.Visible = msoFalse
        End With
        With .PlotArea
            .Format.Fill.Visible = msoFalse
            .Format.Line.Visible = msoFalse
        End With
        With .Axes(xlCategory)
            .Format.Fill.Visible = msoFalse
            .Format.Line.Visible = msoFalse
            .HasMajorGridlines = False
            .HasMinorGridlines = False
            .HasTitle = False
        End With

        With .Axes(xlValue)
            .Format.Fill.Visible = msoFalse
            .Format.Line.Visible = msoFalse
            .HasMajorGridlines = False
            .HasMinorGridlines = False
            .HasTitle = False
        End With
    End With
  

  'グラフエリアをそろえる
    With ActiveSheet.Shapes(shName(0))
        AreaWidth = .Width
        AreaHeight = .Height

        PlotAreaTop = .Chart.PlotArea.Top + 10
        PlotAreaLeft = .Chart.PlotArea.Left + 10
        PlotAreaWidth = .Chart.PlotArea.Width
        PlotAreaHeight = .Chart.PlotArea.Height
    End With
    'プロットエリアをそろえる
    For Each shpName In shName()
        With ActiveSheet.Shapes(shpName)
            .Width = AreaWidth
            .Height = AreaHeight
        End With
        With ActiveSheet.Shapes(shpName).Chart
            .PlotArea.Top = PlotAreaTop
            .PlotArea.Left = PlotAreaLeft
            .PlotArea.Width = PlotAreaWidth
            .PlotArea.Height = PlotAreaHeight
        End With
    Next
    
    
'重ね合わせ
    With ActiveSheet.Shapes(shName(1))
        .Top = Range("F5").Top    '位置を設定
        .Left = Range("F5").Left
        .ZOrder msoBringForward
    End With
    With ActiveSheet.Shapes(shName(2))
        .Top = Range("F5").Top    '位置を設定
        .Left = Range("F5").Left
        .ZOrder msoBringForward
    End With

End Sub

Comments

[zzzTKG]

それは近似曲線ではなく，マーカーのオプションから追加できるマーカーの線ですね．マーカー同士を結んでいるだけのコネクタです．
グラフ要素として追加される近似曲線（Trendlinesで扱われる）はどうしても系列より表面に来てしまうと思うのですが...

Answer 3

近似曲線の透明度を99%にしてみてはいかがでしょう。

Comments

[zzzTKG]

双方に1%でも透明度がかかる時点で凡例幅が短くなり，ずれが生じました．そこで気づいたのですが，透明度を1%以上掛けた際に近似曲線の色が自動から単色に切り替わることで，凡例に表示されている近似曲線の長さが短くなり，凡例幅を狭めているようでした．普通は白黒基本ですので自動設定が任意設定（単色）に変わることの弊害はほぼ無視できるのですが，自動でも対応できるよう追記のコードで実現できました．自動設定の色を取得し，RGBで再設定してコピー元とコピー後の両グラフ間における差を無くしました．無理矢理感がありますのでより良いコード案がありましたらご教授願います．