質問編集履歴
4
追記修正
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -193,6 +193,9 @@
|
|
|
193
193
|
実行後にグラフシートにて表面に来るグラフ（マーカーのみ表示グラフ）
|
|
194
194
|
実行前グラフの近似曲線の色を取得して，同色を単色として再設定し，透明度99%に設定
|
|
195
195
|
|
|
196
|
+
グラフシートにて重なった2つのグラフ
|
|
196
|
-
|
|
197
|
+
|
|
197
198
|
###追記3
|
|
198
|
-
追記1の通り一応望むものはごり押しでできました．今暫く回答受付中にしますので，これよりスマートな記述法がありましたらご教授願います．これが最適である場合にはその旨を教えて下さると幸いです．2020年8月25日17時18分
|
|
199
|
+
追記1の通り一応望むものはごり押しでできました．今暫く回答受付中にしますので，これよりスマートな記述法がありましたらご教授願います．これが最適である場合にはその旨を教えて下さると幸いです．2020年8月25日17時18分
|
|
200
|
+
###追記4
|
|
201
|
+
追記2にて重なったグラフ（完成グラフ）を載せるのを忘れていましたので修正しました．2020年8月25日17時22分
|
3
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -193,4 +193,6 @@
|
|
|
193
193
|
実行後にグラフシートにて表面に来るグラフ（マーカーのみ表示グラフ）
|
|
194
194
|
実行前グラフの近似曲線の色を取得して，同色を単色として再設定し，透明度99%に設定
|
|
195
195
|
|
|
196
|
-
この二つのグラフがグラフシートにて重なり，近似曲線より表面にマーカーが見えるようになっています．
|
|
196
|
+
この二つのグラフがグラフシートにて重なり，近似曲線より表面にマーカーが見えるようになっています．
|
|
197
|
+
###追記3
|
|
198
|
+
追記1の通り一応望むものはごり押しでできました．今暫く回答受付中にしますので，これよりスマートな記述法がありましたらご教授願います．これが最適である場合にはその旨を教えて下さると幸いです．2020年8月25日17時18分
|
2
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -98,7 +98,7 @@
|
|
|
98
98
|
Excel
|
|
99
99
|
2016 32ビット，バージョンは最新の状態
|
|
100
100
|
|
|
101
|
-
###追記
|
|
101
|
+
###追記1
|
|
102
102
|
回答を受けまして，「変更点」と示した部分に設定された色を取得して再設定するコードを付加しました．2020年8月25日17時01分
|
|
103
103
|
```VBA
|
|
104
104
|
Option Explicit
|
|
@@ -181,4 +181,16 @@
|
|
|
181
181
|
OriginSh.Pictures.Paste.Select
|
|
182
182
|
'Application.ScreenUpdating = True
|
|
183
183
|
End Sub
|
|
184
|
-
```
|
|
184
|
+
```
|
|
185
|
+
###追記2
|
|
186
|
+
実際のグラフは動作確認用ですが以下のような感じです．2020年8月25日17時14分
|
|
187
|
+
データ
|
|
188
|
+
|
|
189
|
+
マクロ実行前に選択されるグラフ
|
|
190
|
+
|
|
191
|
+
実行後にグラフシートにて背面に来るグラフ（マーカー以外表示グラフ）
|
|
192
|
+
|
|
193
|
+
実行後にグラフシートにて表面に来るグラフ（マーカーのみ表示グラフ）
|
|
194
|
+
実行前グラフの近似曲線の色を取得して，同色を単色として再設定し，透明度99%に設定
|
|
195
|
+
|
|
196
|
+
この二つのグラフがグラフシートにて重なり，近似曲線より表面にマーカーが見えるようになっています．
|
1
追記
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -96,4 +96,89 @@
|
|
|
96
96
|
PC
|
|
97
97
|
MacBook Air，Intel Core i5-5250U，Boot CampによりWindows 10 Homeにて運用
|
|
98
98
|
Excel
|
|
99
|
-
2016 32ビット，バージョンは最新の状態
|
|
99
|
+
2016 32ビット，バージョンは最新の状態
|
|
100
|
+
|
|
101
|
+
###追記
|
|
102
|
+
回答を受けまして，「変更点」と示した部分に設定された色を取得して再設定するコードを付加しました．2020年8月25日17時01分
|
|
103
|
+
```VBA
|
|
104
|
+
Option Explicit
|
|
105
|
+
Sub Macro1()
|
|
106
|
+
Dim PlotCha As ChartObject
|
|
107
|
+
Dim LineCha As ChartObject
|
|
108
|
+
Dim OriginSh As Worksheet
|
|
109
|
+
Dim LineName As String
|
|
110
|
+
'On Error Resume Next
|
|
111
|
+
Set LineCha = ActiveChart.Parent
|
|
112
|
+
LineName = LineCha.Name
|
|
113
|
+
Set OriginSh = ActiveSheet
|
|
114
|
+
If LineCha Is Nothing Then
|
|
115
|
+
MsgBox "白抜きプロットにするグラフを選んでから実行してください．", Title:="手順ミス"
|
|
116
|
+
Exit Sub
|
|
117
|
+
End If
|
|
118
|
+
LineCha.Chart.ChartArea.Copy
|
|
119
|
+
Range("A1").Select
|
|
120
|
+
'Application.ScreenUpdating = False
|
|
121
|
+
OriginSh.Paste
|
|
122
|
+
Set PlotCha = Selection.Parent.Parent
|
|
123
|
+
Dim PlotName As String
|
|
124
|
+
PlotName = LineName & "Copy"
|
|
125
|
+
PlotCha.Name = PlotName
|
|
126
|
+
With OriginSh.Shapes(LineName)
|
|
127
|
+
.Fill.Visible = msoFalse
|
|
128
|
+
.Line.Visible = msoFalse
|
|
129
|
+
End With
|
|
130
|
+
With LineCha.Chart
|
|
131
|
+
Dim i As Long
|
|
132
|
+
For i = 1 To .FullSeriesCollection.Count
|
|
133
|
+
.FullSeriesCollection(i).MarkerStyle = xlMarkerStyleNone
|
|
134
|
+
Next i
|
|
135
|
+
Dim ChartSh As String
|
|
136
|
+
ChartSh = "Sheet_" & LineName
|
|
137
|
+
.Location xlLocationAsNewSheet, Name:=ChartSh
|
|
138
|
+
End With
|
|
139
|
+
With OriginSh.Shapes(PlotName)
|
|
140
|
+
.Fill.Visible = msoFalse
|
|
141
|
+
.Line.Visible = msoFalse
|
|
142
|
+
End With
|
|
143
|
+
With PlotCha.Chart
|
|
144
|
+
.ChartArea.Format.TextFrame2.TextRange.Font.Fill.Transparency = 0.99
|
|
145
|
+
With .Axes(xlCategory)
|
|
146
|
+
.MajorGridlines.Format.Line.Visible = msoFalse
|
|
147
|
+
With .Format
|
|
148
|
+
.Line.Visible = msoFalse
|
|
149
|
+
.Fill.Visible = msoFalse
|
|
150
|
+
End With
|
|
151
|
+
End With
|
|
152
|
+
With .Axes(xlValue)
|
|
153
|
+
.MajorGridlines.Format.Line.Visible = msoFalse
|
|
154
|
+
With .Format
|
|
155
|
+
.Line.Visible = msoFalse
|
|
156
|
+
.Fill.Visible = msoFalse
|
|
157
|
+
End With
|
|
158
|
+
End With
|
|
159
|
+
Dim j As Long
|
|
160
|
+
For j = 1 To .FullSeriesCollection.Count
|
|
161
|
+
With .FullSeriesCollection(j)
|
|
162
|
+
Dim k As Long
|
|
163
|
+
For k = 1 To .Trendlines.Count
|
|
164
|
+
With .Trendlines(k).Format.Line
|
|
165
|
+
Dim LineCol As Variant
|
|
166
|
+
LineCol = .ForeColor
|
|
167
|
+
.ForeColor.RGB = RGB(LineCol Mod 256, Int(LineCol / 256) Mod 256, Int(LineCol / 256 / 256)) '変更点
|
|
168
|
+
.Transparency = 0.99
|
|
169
|
+
End With
|
|
170
|
+
Next k
|
|
171
|
+
End With
|
|
172
|
+
.FullSeriesCollection(j).Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
|
|
173
|
+
Next j
|
|
174
|
+
.Location xlLocationAsObject, Name:=ChartSh
|
|
175
|
+
End With
|
|
176
|
+
With Sheets(ChartSh).Shapes(PlotName)
|
|
177
|
+
.ScaleWidth 2.0341434821, msoFalse, msoScaleFromTopLeft
|
|
178
|
+
.ScaleHeight 2.2135414844, msoFalse, msoScaleFromTopLeft
|
|
179
|
+
End With
|
|
180
|
+
ActiveChart.ChartArea.Copy
|
|
181
|
+
OriginSh.Pictures.Paste.Select
|
|
182
|
+
'Application.ScreenUpdating = True
|
|
183
|
+
End Sub
|
|
184
|
+
```
|