Предоставление пользователю задать значения

[REztor]

Имею, такой макрос http://rusfolder.com/34567895
Как можно сделать, чтобы значение предлагалось ввести пользователю, то есть мне по нажатии на кнопку в меню надстройки?
Чтобы не бегать постоянно в разработчик и там менять значения

[EducatedFool]

Замените макрос

Sub Get_Graphics()
    Dim ChrtObj As ChartObject
    For Each ChrtObj In ActiveSheet.ChartObjects
        ChrtObj.Height = 200
        ChrtObj.Width = 300
    Next
End Sub

на следующий:

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

[REztor]

Спасибо вам большое.
А как можно этот макрос переделать в надстройку? Что-то нежу формата Add-in для сохранения макроса как надстройку

[EducatedFool]

А как можно этот макрос переделать в надстройку?

Можно.
Переделывайте.

Достаточно файл Excel, содержащий макросы, сохранить в формате «Надстройка Excel» (вмеcто «Книга Excel»)

Можно вашему макросу и кнопку добавить, на панели инструментов:
http://excelvba.ru/tools/CommandBar

Или назначить «горячую клавишу» через application.OnKey

[REztor]

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

[REztor]

Сообщение от EducatedFool

Можно.
Переделывайте.

Достаточно файл Excel, содержащий макросы, сохранить в формате «Надстройка Excel» (вмеcто «Книга Excel»)

Можно вашему макросу и кнопку добавить, на панели инструментов:
http://excelvba.ru/tools/CommandBar

Или назначить «горячую клавишу» через application.OnKey

Сохранил как надстройку.
Кнопку тоже сделал

Private Sub Workbook_Open()
  Dim cbrMenu As CommandBar
   Dim cbrcMenu As CommandBarControl     
   Dim cbrcSubMenu As CommandBarControl  
  
   On Error Resume Next
   Application.CommandBars("Graphics").Delete
   On Error GoTo 0

   Set cbrMenu = Application.CommandBars.Add("Graphics", msoBarLeft, False, True)
   Set cbrcMenu = cbrMenu.Controls.Add(msoControlPopup, , , , True)

   With cbrcMenu

      .Caption = "Graphics"

   End With

   With cbrcMenu.Controls.Add(Type:=msoControlButton, Temporary:=True)

    .Caption = "Изменение размера"
    '.FaceId = 2103
    .OnAction = "Get_Graphics"

   End With
       
    cbrMenu.Visible = True
End Sub

Теперь пыпаюсь сделать, чтобы макрос работал Microsoft Office Power Point и Word

[EducatedFool]

чтобы макрос работал Microsoft Office Power Point и Word

Для других программ, макрос надо переписывать
(для Word - будет одно, для PowerPoint - другое)

Менять надо выделенное красным:

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

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

На что менять - не знаю
Запишете макрос макрорекордером в Word и PowerPoint - увидите

[REztor]

А кнопку можно будет добавить на панель инструментов в Word и PowerPoint?

[REztor]

PowerPoint

 ChartObject - ActiveSlide
ActiveSheet.ChartObjects - ActiveSlide.Shapes

Word

ChartObject - InlineShape
ActiveSheet.ChartObjects - ActiveDocument.InlineShapes

[REztor]

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
    If sh.Type = msoChart Then
        sh.Height = h
        sh.Width = w
    End If
Next
End Sub