| Invincible |
10-12-2012 17:40 2042546 |
Макрос для приведения к одному, одинаковому размеру графиков
Подскажите макрос для приведения к одному, одинаковому размеру всех графиков.
Или какой-нибудь другой способ как это можно сделать
|
Откуда брать этот «один, одинаковый размер»? Вариант «настроить как образец размеры одного графика, выделить его, вызвать макрос» — устроит?
okshef, я ж помню, что было. А вот не нашёл :(. Это не совсем то.
|
| Invincible |
10-12-2012 21:22 2042713 |
Цитата:
Цитата Iska
Откуда брать этот «один, одинаковый размер»? Вариант «настроить как образец размеры одного графика, выделить его, вызвать макрос» — устроит? »
|
Да, если можно |
Invincible, что с этим вопросом:
Цитата:
Цитата okshef
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 |
10-12-2012 23:15 2042766 |
Цитата:
Цитата Iska
Если укажете как и чем были сделаны графики, можно подумать об отделении их от прочих объектов. »
|
Графики строил в Excel, обычные гистограммы и диаграммы |
Invincible, можете упаковать пример файла в архив, выложить на обменник, а ссылку — сюда или в личку?
|
| Invincible |
23-12-2012 22:44 2051950 |
|
Код:
ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Width = 283
Selection.ShapeRange.Height = 170
Значения Width и Height подбирайте сами. |
| Invincible |
18-01-2013 00:56 2069221 |
Имею, такой макрос
Цитата:
Цитата okshef
Значения Width и Height подбирайте сами. »
|
Как можно сделать, чтобы значение предлагалось ввести пользователю, то есть мне по нажатии на кнопку в меню надстройки?
Чтобы не бегать постоянно в разработчик и там менять значения
http://rusfolder.com/34567895 |
| Invincible |
25-01-2013 00:28 2074374 |
Сделал так
Код:
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 |
06-02-2013 22:18 2084051 |
Код:
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
|
Время: 15:17.
© OSzone.net 2001-
