Excelグラフのサイズ統一
excelで作った複数のグラフを、パワポなどに貼り付ける為に、同じサイズにしたい。
基本的に元のグラフをコピペで良いけど、入りきらないときや、サイズ変更が必要な時に、まとめてサイズ変更できれば楽かな、とおもい作成。
使い方は、このサイズにしたい、というグラフを選んだら、Ctrlを押しながら、反映させたいグラフを選択してからマクロ実行。
Option Explicit Dim orgChart As ChartObject Dim nChart As ChartObject Sub グラフサイズ統一() Dim slctn As Object Dim i As Long Dim lgndR As Double Dim textArea As Double On Error GoTo ErrTag1 '選択グラフが1つのとき If TypeName(Selection) <> "DrawingObjects" Then MsgBox "グラフを複数選択してください" Exit Sub End If Set slctn = Selection Set orgChart = slctn.Item(1) For i = 2 To Selection.Count Set nChart = slctn.Item(i) '●●項目有り無しケース●● If (orgChart.Chart.Axes(xlCategory).TickLabelPosition = xlNone) Xor _ (nChart.Chart.Axes(xlCategory).TickLabelPosition = xlNone) Then Select Case orgChart.Chart.Type Case xlBar '横棒グラフ nChart.Width = orgChart.Width nChart.Height = orgChart.Height 'ここの処理が場当たり的。0.5はtry & error textArea = (orgChart.Chart.PlotArea.Width - orgChart.Chart.PlotArea.InsideWidth) - (nChart.Chart.PlotArea.Width - nChart.Chart.PlotArea.InsideWidth) - 0.5 nChart.Width = nChart.Width - textArea Call chrtResize nChart.Chart.PlotArea.Width = orgChart.Chart.PlotArea.Width - textArea If orgChart.Chart.HasLegend And nChart.Chart.HasLegend Then Call lgndResize(lgndR) End If Case xlColumn, xlLine '縦棒グラフor横折れ線グラフ nChart.Width = orgChart.Width nChart.Height = orgChart.Height 'ここの処理が場当たり的。0.5はtry & error textArea = (orgChart.Chart.PlotArea.Height - orgChart.Chart.PlotArea.InsideHeight) - (nChart.Chart.PlotArea.Height - nChart.Chart.PlotArea.InsideHeight) - 0.5 nChart.Height = nChart.Height - textArea Call chrtResize nChart.Chart.PlotArea.Height = orgChart.Chart.PlotArea.Height - textArea If orgChart.Chart.HasLegend And nChart.Chart.HasLegend Then Call lgndResize End If ' Case 2 ' case ?????'円グラフTickLabelCheckではじかれるので・・・ End Select '●●項目有り有りor無し無しケース●● Else nChart.Width = orgChart.Width nChart.Height = orgChart.Height Call chrtResize If orgChart.Chart.HasLegend And nChart.Chart.HasLegend Then Call lgndResize End If End If Next i Exit Sub ErrTag1: MsgBox "このグラフは当マクロでは加工できません。" End Sub '凡例のリサイズ Sub lgndResize(Optional R As Variant) nChart.Chart.Legend.Width = 5 nChart.Chart.Legend.Height = 5 nChart.Chart.Legend.Top = orgChart.Chart.Legend.Top If IsMissing(R) Then lgndR = orgChart.Chart.PlotArea.Width - orgChart.Chart.Legend.Left nChart.Chart.Legend.Left = orgChart.Chart.Legend.Left Else If nChart.Chart.PlotArea.Width - R < 0 Then nChart.Chart.Legend.Left = 0 Else nChart.Chart.Legend.Left = nChart.Chart.PlotArea.Width - R End If End If nChart.Chart.Legend.Width = orgChart.Chart.Legend.Width nChart.Chart.Legend.Height = orgChart.Chart.Legend.Height End Sub Sub chrtResize() nChart.Chart.PlotArea.Width = 5 nChart.Chart.PlotArea.Height = 5 nChart.Chart.PlotArea.Top = orgChart.Chart.PlotArea.Top nChart.Chart.PlotArea.Left = orgChart.Chart.PlotArea.Left nChart.Chart.PlotArea.Width = orgChart.Chart.PlotArea.Width nChart.Chart.PlotArea.Height = orgChart.Chart.PlotArea.Height End Sub
反省と今後
・このひどいコードは自戒のためのさらし者である。
・使途が限定的過ぎる。
・同じ名前のグラフがあると、エクセルごと落ちる。やばい。
・エクセルで作成されるグラフには、サイズをいじれる部分とそうでない部分がある。