| |
グラフシートではなく、ワークシートに埋め込んだグラフですよね ?
こんな感じで出来るようです。
グラフのあるシートのシートオブジェクトに
Private Sub Worksheet_Activate()
Dim Ch As ChartObject
Set MyDic = CreateObject("Scripting.Dictionary")
Set MyDic2 = CreateObject("Scripting.Dictionary")
On Error Resume Next
MyDic.RemoveAll: MyDic2.RemoveAll
If ActiveSheet.ChartObjects.Count = 0 Then
Exit Sub
End If
For Each Ch In ActiveSheet.ChartObjects
Ch.OnAction = "Test_ChResize"
MyDic.Add CStr(Ch.Width), CStr(Ch.Height)
MyDic2.Add CStr(Ch.Left), CStr(Ch.Top)
Next
End Sub
標準モジュールに
Public MyDic As Object, MyDic2 As Object
'↑モジュールの先頭に宣言する。
Sub Test_ChResize()
Dim x As Variant, KAry As Variant, IAry As Variant
Dim KAry2 As Variant, IAry2 As Variant
Dim WL As Single, WT As Single, WW As Single, WH As Single
Dim Ind As Integer
x = Application.Caller
If VarTyp(x) <> 8 Then Exit Sub
If MyDic.Count = 0 Then Exit Sub
With ActiveWindow.VisibleRange
WL = .Cells(1).Left: WT = .Cells(1).Top
WW = .Width - 50: WH = .Height - 10
End With
KAry = MyDic.Keys: IAry = MyDic.Items
KAry2 = MyDic2.Keys: IAry2 = MyDic2.Items
With ActiveSheet.ChartObjects(x)
Ind = .Index - 1
If .Width > WW - 5 And .Width < WW + 5 Then
.Left = CSng(KAry2(Ind))
.Top = CSng(IAry2(Ind))
.Width = CSng(KAry(Ind))
.Height = CSng(IAry(Ind))
Else
.Left = WL: .Top = WT
.Width = WW: .Height = WH
End If
End With
End Sub
を入れ、該当のシートから一度別のシートを開き、戻ります。するとグラフを
クリックしたとき画面全体に拡大して表示し、再度クリックすると元の位置と
サイズに戻ります。拡大したときのサイズは
>WW = .Width - 50: WH = .Height - 10
で、調節して下さい。
|
|
