Форум программистов [Powered by Invision Power Board]

Версия для печати темы
Нажмите сюда для просмотра этой темы в оригинальном формате

Форум программистов > Работа с MS Office > Предоставление пользователю задать значения

Автор: WingfirE 18.1.2013, 00:10

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

Автор: dorogoyIV 18.1.2013, 09:54

не очень понял, что нужно...
так что ли?

Код


Option Explicit

Sub Get_Graphics()
 Dim ChrtObj As ChartObject

 Dim w As Integer, h As Integer
 w = InputBox("width", , 300)
 h = InputBox("height", , 300)

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

Автор: WingfirE 23.1.2013, 23:57

dorogoyIV, Спасибо

Автор: WingfirE 24.1.2013, 23:26

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

Добавлено через 5 минут и 53 секунды

Код


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

Автор: WingfirE 6.2.2013, 21:17

Код

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

Автор: Balia1992 1.6.2014, 23:43

3*х-14+e^x-e^-x=0 ПОМОГИТЕ РЕШИТЬ В ПАСКАЛЕ