質問編集履歴
4
追記修正
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -388,8 +388,14 @@
|
|
|
388
388
|
|
|
389
389
|
|
|
390
390
|
|
|
391
|
+
グラフシートにて重なった2つのグラフ
|
|
392
|
+
|
|
391
|
-
|
|
393
|
+
|
|
392
394
|
|
|
393
395
|
###追記3
|
|
394
396
|
|
|
395
397
|
追記1の通り一応望むものはごり押しでできました．今暫く回答受付中にしますので，これよりスマートな記述法がありましたらご教授願います．これが最適である場合にはその旨を教えて下さると幸いです．2020年8月25日17時18分
|
|
398
|
+
|
|
399
|
+
###追記4
|
|
400
|
+
|
|
401
|
+
追記2にて重なったグラフ（完成グラフ）を載せるのを忘れていましたので修正しました．2020年8月25日17時22分
|
3
追記
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -389,3 +389,7 @@
|
|
|
389
389
|
|
|
390
390
|
|
|
391
391
|
この二つのグラフがグラフシートにて重なり，近似曲線より表面にマーカーが見えるようになっています．
|
|
392
|
+
|
|
393
|
+
###追記3
|
|
394
|
+
|
|
395
|
+
追記1の通り一応望むものはごり押しでできました．今暫く回答受付中にしますので，これよりスマートな記述法がありましたらご教授願います．これが最適である場合にはその旨を教えて下さると幸いです．2020年8月25日17時18分
|
2
追記
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -198,7 +198,7 @@
|
|
|
198
198
|
|
|
199
199
|
|
|
200
200
|
|
|
201
|
-
###追記
|
|
201
|
+
###追記1
|
|
202
202
|
|
|
203
203
|
回答を受けまして，「変更点」と示した部分に設定された色を取得して再設定するコードを付加しました．2020年8月25日17時01分
|
|
204
204
|
|
|
@@ -365,3 +365,27 @@
|
|
|
365
365
|
End Sub
|
|
366
366
|
|
|
367
367
|
```
|
|
368
|
+
|
|
369
|
+
###追記2
|
|
370
|
+
|
|
371
|
+
実際のグラフは動作確認用ですが以下のような感じです．2020年8月25日17時14分
|
|
372
|
+
|
|
373
|
+
データ
|
|
374
|
+
|
|
375
|
+
|
|
376
|
+
|
|
377
|
+
マクロ実行前に選択されるグラフ
|
|
378
|
+
|
|
379
|
+
|
|
380
|
+
|
|
381
|
+
実行後にグラフシートにて背面に来るグラフ（マーカー以外表示グラフ）
|
|
382
|
+
|
|
383
|
+
|
|
384
|
+
|
|
385
|
+
実行後にグラフシートにて表面に来るグラフ（マーカーのみ表示グラフ）
|
|
386
|
+
|
|
387
|
+
実行前グラフの近似曲線の色を取得して，同色を単色として再設定し，透明度99%に設定
|
|
388
|
+
|
|
389
|
+
|
|
390
|
+
|
|
391
|
+
この二つのグラフがグラフシートにて重なり，近似曲線より表面にマーカーが見えるようになっています．
|
1
追記
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -195,3 +195,173 @@
|
|
|
195
195
|
Excel
|
|
196
196
|
|
|
197
197
|
2016 32ビット，バージョンは最新の状態
|
|
198
|
+
|
|
199
|
+
|
|
200
|
+
|
|
201
|
+
###追記
|
|
202
|
+
|
|
203
|
+
回答を受けまして，「変更点」と示した部分に設定された色を取得して再設定するコードを付加しました．2020年8月25日17時01分
|
|
204
|
+
|
|
205
|
+
```VBA
|
|
206
|
+
|
|
207
|
+
Option Explicit
|
|
208
|
+
|
|
209
|
+
Sub Macro1()
|
|
210
|
+
|
|
211
|
+
Dim PlotCha As ChartObject
|
|
212
|
+
|
|
213
|
+
Dim LineCha As ChartObject
|
|
214
|
+
|
|
215
|
+
Dim OriginSh As Worksheet
|
|
216
|
+
|
|
217
|
+
Dim LineName As String
|
|
218
|
+
|
|
219
|
+
'On Error Resume Next
|
|
220
|
+
|
|
221
|
+
Set LineCha = ActiveChart.Parent
|
|
222
|
+
|
|
223
|
+
LineName = LineCha.Name
|
|
224
|
+
|
|
225
|
+
Set OriginSh = ActiveSheet
|
|
226
|
+
|
|
227
|
+
If LineCha Is Nothing Then
|
|
228
|
+
|
|
229
|
+
MsgBox "白抜きプロットにするグラフを選んでから実行してください．", Title:="手順ミス"
|
|
230
|
+
|
|
231
|
+
Exit Sub
|
|
232
|
+
|
|
233
|
+
End If
|
|
234
|
+
|
|
235
|
+
LineCha.Chart.ChartArea.Copy
|
|
236
|
+
|
|
237
|
+
Range("A1").Select
|
|
238
|
+
|
|
239
|
+
'Application.ScreenUpdating = False
|
|
240
|
+
|
|
241
|
+
OriginSh.Paste
|
|
242
|
+
|
|
243
|
+
Set PlotCha = Selection.Parent.Parent
|
|
244
|
+
|
|
245
|
+
Dim PlotName As String
|
|
246
|
+
|
|
247
|
+
PlotName = LineName & "Copy"
|
|
248
|
+
|
|
249
|
+
PlotCha.Name = PlotName
|
|
250
|
+
|
|
251
|
+
With OriginSh.Shapes(LineName)
|
|
252
|
+
|
|
253
|
+
.Fill.Visible = msoFalse
|
|
254
|
+
|
|
255
|
+
.Line.Visible = msoFalse
|
|
256
|
+
|
|
257
|
+
End With
|
|
258
|
+
|
|
259
|
+
With LineCha.Chart
|
|
260
|
+
|
|
261
|
+
Dim i As Long
|
|
262
|
+
|
|
263
|
+
For i = 1 To .FullSeriesCollection.Count
|
|
264
|
+
|
|
265
|
+
.FullSeriesCollection(i).MarkerStyle = xlMarkerStyleNone
|
|
266
|
+
|
|
267
|
+
Next i
|
|
268
|
+
|
|
269
|
+
Dim ChartSh As String
|
|
270
|
+
|
|
271
|
+
ChartSh = "Sheet_" & LineName
|
|
272
|
+
|
|
273
|
+
.Location xlLocationAsNewSheet, Name:=ChartSh
|
|
274
|
+
|
|
275
|
+
End With
|
|
276
|
+
|
|
277
|
+
With OriginSh.Shapes(PlotName)
|
|
278
|
+
|
|
279
|
+
.Fill.Visible = msoFalse
|
|
280
|
+
|
|
281
|
+
.Line.Visible = msoFalse
|
|
282
|
+
|
|
283
|
+
End With
|
|
284
|
+
|
|
285
|
+
With PlotCha.Chart
|
|
286
|
+
|
|
287
|
+
.ChartArea.Format.TextFrame2.TextRange.Font.Fill.Transparency = 0.99
|
|
288
|
+
|
|
289
|
+
With .Axes(xlCategory)
|
|
290
|
+
|
|
291
|
+
.MajorGridlines.Format.Line.Visible = msoFalse
|
|
292
|
+
|
|
293
|
+
With .Format
|
|
294
|
+
|
|
295
|
+
.Line.Visible = msoFalse
|
|
296
|
+
|
|
297
|
+
.Fill.Visible = msoFalse
|
|
298
|
+
|
|
299
|
+
End With
|
|
300
|
+
|
|
301
|
+
End With
|
|
302
|
+
|
|
303
|
+
With .Axes(xlValue)
|
|
304
|
+
|
|
305
|
+
.MajorGridlines.Format.Line.Visible = msoFalse
|
|
306
|
+
|
|
307
|
+
With .Format
|
|
308
|
+
|
|
309
|
+
.Line.Visible = msoFalse
|
|
310
|
+
|
|
311
|
+
.Fill.Visible = msoFalse
|
|
312
|
+
|
|
313
|
+
End With
|
|
314
|
+
|
|
315
|
+
End With
|
|
316
|
+
|
|
317
|
+
Dim j As Long
|
|
318
|
+
|
|
319
|
+
For j = 1 To .FullSeriesCollection.Count
|
|
320
|
+
|
|
321
|
+
With .FullSeriesCollection(j)
|
|
322
|
+
|
|
323
|
+
Dim k As Long
|
|
324
|
+
|
|
325
|
+
For k = 1 To .Trendlines.Count
|
|
326
|
+
|
|
327
|
+
With .Trendlines(k).Format.Line
|
|
328
|
+
|
|
329
|
+
Dim LineCol As Variant
|
|
330
|
+
|
|
331
|
+
LineCol = .ForeColor
|
|
332
|
+
|
|
333
|
+
.ForeColor.RGB = RGB(LineCol Mod 256, Int(LineCol / 256) Mod 256, Int(LineCol / 256 / 256)) '変更点
|
|
334
|
+
|
|
335
|
+
.Transparency = 0.99
|
|
336
|
+
|
|
337
|
+
End With
|
|
338
|
+
|
|
339
|
+
Next k
|
|
340
|
+
|
|
341
|
+
End With
|
|
342
|
+
|
|
343
|
+
.FullSeriesCollection(j).Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
|
|
344
|
+
|
|
345
|
+
Next j
|
|
346
|
+
|
|
347
|
+
.Location xlLocationAsObject, Name:=ChartSh
|
|
348
|
+
|
|
349
|
+
End With
|
|
350
|
+
|
|
351
|
+
With Sheets(ChartSh).Shapes(PlotName)
|
|
352
|
+
|
|
353
|
+
.ScaleWidth 2.0341434821, msoFalse, msoScaleFromTopLeft
|
|
354
|
+
|
|
355
|
+
.ScaleHeight 2.2135414844, msoFalse, msoScaleFromTopLeft
|
|
356
|
+
|
|
357
|
+
End With
|
|
358
|
+
|
|
359
|
+
ActiveChart.ChartArea.Copy
|
|
360
|
+
|
|
361
|
+
OriginSh.Pictures.Paste.Select
|
|
362
|
+
|
|
363
|
+
'Application.ScreenUpdating = True
|
|
364
|
+
|
|
365
|
+
End Sub
|
|
366
|
+
|
|
367
|
+
```
|