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

WingfirE

Дата 18.1.2013, 00:10 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 110
Регистрация: 10.3.2012

Репутация: нет
Всего: нет

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

dorogoyIV

Дата 18.1.2013, 09:54 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1503
Регистрация: 26.3.2007

Репутация: нет
Всего: 46

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

Код


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 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 110
Регистрация: 10.3.2012

Репутация: нет
Всего: нет

dorogoyIV, Спасибо

WingfirE

Дата 24.1.2013, 23:26 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 110
Регистрация: 10.3.2012

Репутация: нет
Всего: нет

А можно использовать данный макрос в 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 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 110
Регистрация: 10.3.2012

Репутация: нет
Всего: нет

Код

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
Регистрация: 1.6.2014

Репутация: нет
Всего: нет

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

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Работа с MS Office \| Следующая тема »