[Invincible]

Сделал так

Код:

Sub Get_Graphics()
    On Error Resume Next: Err.Clear
    Dim ChrtObj As ChartObject, w&, h&
    ' запрашиваем у пользователя высоту и ширину
    w& = InputBox("Введите ширину для диаграмм", , 300): If Err Then Exit Sub
    h& = InputBox("Введите высоту для диаграмм", , 200): If Err Then Exit Sub

    Application.ScreenUpdating = False
    For Each ChrtObj In ActiveSheet.ChartObjects
        ChrtObj.Height = h&
        ChrtObj.Width = w&
    Next
End Sub

А можно использовать данный макрос в Microsoft Office Power Point?

[Invincible]

Код:

Sub test2()  
Dim sh As Shape, ActiveSlide As Slide, w As Long, h As Long  On Error Resume Next: Err.Clear     
Set ActiveSlide = ActiveWindow.Selection.SlideRange(1)  
h = InputBox("Height", , 200): If Err Then Exit Sub  
w = InputBox("Width", , 300): If Err Then Exit Sub     
For Each sh In ActiveSlide.Shapes      
f sh.Type = msoChart Then          
sh.Height = h          
sh.Width = w      
End If  Next  End Sub