回答編集履歴

teisei

2020/08/27 17:03

投稿

sinzou

スコア392

answer CHANGED Viewed

@@ -46,9 +46,9 @@
     With ActiveSheet.Shapes(shName(0))
         For j = 1 To .Chart.FullSeriesCollection.Count
             With .Chart.FullSeriesCollection(j)
-                .Name = "系統" & j + 1
+                .Name = "系統" & j
                 .Trendlines.Add Type:=xlLinear, Forward:=0, Backward:=0, _
-                    DisplayEquation:=0, DisplayRSquared:=0, Name:="線形 (系統" & j + 1 & ")"
+                    DisplayEquation:=0, DisplayRSquared:=0, Name:="線形 (系統" & j & ")"
                 col = .Format.Line.ForeColor
                 With .Trendlines(1)

修正

2020/08/27 17:03

投稿

sinzou

スコア392

answer CHANGED Viewed

@@ -1,39 +1,216 @@
+（修正、載せ替え）
-![に適用すると](31cbbe6df7d07bae01792b28af46e34a.png)
+![イメージ説明](05782742e06dd55188b9c413636986b6.png)
-に適用すると
+```VBA
-![に適用すると](16c0ef7cf59a8ad850231f872ce50fa7.png)
-に加工できる、あと色と濃度かえるとか、、、ちがった？？
+Sub tes01()
-```vba
-Sub tes0()
-'
-Dim j, linCount, newLin, mkStyle
+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
-With ActiveChart
-    linCount = .FullSeriesCollection.Count 'グラフのデータ系列の数
-    For j = 1 To linCount
-        newLin = j + linCount
         .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
-        .FullSeriesCollection(newLin).Values = .FullSeriesCollection(j).Values
+    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 + 1
+                .Trendlines.Add Type:=xlLinear, Forward:=0, Backward:=0, _
+                    DisplayEquation:=0, DisplayRSquared:=0, Name:="線形 (系統" & j + 1 & ")"
+                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 .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
-            '.MarkerSize = 5
         End With
-'コピーした系統をラインに
+        With .PlotArea
+            .Format.Fill.Visible = msoTrue
+            .Format.Line.Visible = msoFalse
+        End With
-        With .FullSeriesCollection(newLin)
+        With .Axes(xlValue)
-            .MarkerStyle = -4142
             With .Format.Line
                 .Visible = msoTrue
+                .ForeColor.ObjectThemeColor = msoThemeColorBackground1
+                .ForeColor.TintAndShade = 0
-                .DashStyle = msoLineSysDot
+                .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
-        .FullSeriesCollection(j).Name = "系統" & j
-        .FullSeriesCollection(newLin).Name = "線形(系統" & j & ")"
-    Next j
-    '.FullSeriesCollection(j).Format.Fill.ForeColor.ObjectThemeColor = msoThemeColorBackground1
-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
 ```