[VBA] 散布図グラフを正方形化する:Excel VBA

 Excelのグラフは機能が貧弱で、なんでこの機能がないの?なんて事がよくあります。私は、機能を補うために、VBAを利用しています。
 散布図では横軸と縦軸が同じ場合、ぴったりサイズを合わせたくないですか?

 そんなあなたのためのVBAを紹介します。
 使い方は、グラフを選択して、マクロを実行するだけ。ツールバーにアイコンを登録しておくと便利です。

 散布図に対角線を引くマクロとあわせるとさらに便利です。

散布図を正方形化するマクロ


Sub PAtoSQR()
'
' 散布図用 散布図は正方形Macro
' マクロ記録日 : 2001/8/29 ユーザー名 : uzumaki7
On Error GoTo ErrorHandler

If ActiveChart Is Nothing Then
MsgBox "アクティブなグラフがありません!"
Exit Sub
End If

With ActiveChart
'フォントの自動サイズ変更の停止
.ChartArea.AutoScaleFont = False

'最大スケール合わせ(最大値に合わせる)
If .Axes(xlCategory).MaximumScale >= .Axes(xlValue).MaximumScale Then
.Axes(xlValue).MaximumScale = .Axes(xlCategory).MaximumScale
.Axes(xlCategory).MaximumScaleIsAuto = False
Else
.Axes(xlCategory).MaximumScale = .Axes(xlValue).MaximumScale
.Axes(xlValue).MaximumScaleIsAuto = False
End If

'最小スケール合わせ(最小値に合わせる)
If .Axes(xlCategory).MinimumScale <= .Axes(xlValue).MinimumScale Then
.Axes(xlValue).MinimumScale = .Axes(xlCategory).MinimumScale
.Axes(xlCategory).MinimumScaleIsAuto = False
Else
.Axes(xlCategory).MinimumScale = .Axes(xlValue).MinimumScale
.Axes(xlValue).MinimumScaleIsAuto = False
End If

'間隔合わせ
If .Axes(xlCategory).MajorUnit >= .Axes(xlValue).MajorUnit Then
.Axes(xlValue).MajorUnit = .Axes(xlCategory).MajorUnit
.Axes(xlCategory).MajorUnitIsAuto = False
Else
.Axes(xlCategory).MajorUnit = .Axes(xlValue).MajorUnit
.Axes(xlValue).MajorUnitIsAuto = False
End If

'正方形化
With .PlotArea
.Width = .Width - .InsideWidth + .InsideHeight
End With
End With

ErrorHandler:
Exit Sub
End Sub

posted by うずまき at 21:41 | Comment(0) | TrackBack(0) | VBA
この記事へのコメント
コメントを書く
お名前:

メールアドレス:

ホームページアドレス:

コメント:

この記事へのTrackBack URL
http://blog.seesaa.jp/tb/34348813
×

この広告は1年以上新しい記事の投稿がないブログに表示されております。