[решено] Макрос для приведения к одному, одинаковому размеру графиков

[Invincible]

Подскажите макрос для приведения к одному, одинаковому размеру всех графиков.
Или какой-нибудь другой способ как это можно сделать

[okshef]

Invincible, еще бы знать, какое приложение вы имеете в виду?

Для Word: Как моментально изменить масштаб всех картинок в документе Word (http://www.outsidethebox.ms/14276/)

[Iska]

Откуда брать этот «один, одинаковый размер»? Вариант «настроить как образец размеры одного графика, выделить его, вызвать макрос» — устроит?

okshef, я ж помню, что было. А вот не нашёл :(. Это не совсем то.

[Invincible]

Откуда брать этот «один, одинаковый размер»? Вариант «настроить как образец размеры одного графика, выделить его, вызвать макрос» — устроит? »
Да, если можно

[Iska]

Invincible, что с этим вопросом:
Invincible, еще бы знать, какое приложение вы имеете в виду? »

Вот пример макроса для любых объектов (не только графиков), расположенных в тексте документа Microsoft Word:
Option Explicit

Sub Sample()
Dim objInlineShapeMaster As InlineShape
Dim objInlineShape As InlineShape

If Selection.Type = wdSelectionInlineShape Then
Set objInlineShapeMaster = Selection.InlineShapes.Item(1)

For Each objInlineShape In ActiveDocument.Content.InlineShapes
With objInlineShape
.LockAspectRatio = msoTrue
.Height = objInlineShapeMaster.Height
.Width = objInlineShapeMaster.Width
End With
Next

Set objInlineShapeMaster = Nothing
Else
MsgBox "Not a InlineShape in Selection", vbCritical + vbOKOnly, "Error"
End If
End Sub

Если укажете как и чем были сделаны графики, можно подумать об отделении их от прочих объектов.

[Invincible]

Если укажете как и чем были сделаны графики, можно подумать об отделении их от прочих объектов. »
Графики строил в Excel, обычные гистограммы и диаграммы

[Iska]

Invincible, можете упаковать пример файла в архив, выложить на обменник, а ссылку — сюда или в личку?

[Invincible]

можете упаковать пример файла в архив, выложить на обменник, а ссылку — сюда или в личку? »
http://rusfolder.com/34252389

[okshef]

ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = 283
Selection.ShapeRange.Height = 170
Значения Width и Height подбирайте сами.

[Invincible]

Имею, такой макрос
Значения Width и Height подбирайте сами. »
Как можно сделать, чтобы значение предлагалось ввести пользователю, то есть мне по нажатии на кнопку в меню надстройки?
Чтобы не бегать постоянно в разработчик и там менять значения

http://rusfolder.com/34567895

[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