Макрос в word - форматирование рисунков

[darklumen]

здравствуйте.
есть текст - в нем много рисунков, оформленных хаотично, т.е некоторые рисунки выходят за пределы страницы, некоторые выровнены по ширине, другие по левому краю.

необходимо создать макрос, который выравнивал бы все странички по центру и делал так, что бы они не выходили за пределы страничек.

заранее спасибо=)

[Busine2009]

Я тебе помочь не смогу, но тоже пытался написать макрос для придания Рисункам определённого размера, а именно под поля страниц. Но там нельзя соблюсти сохранение пропорций между вертикальными и горизонтальными сторонами. И причём в точках идёт размер Рисунка. Я на выходных попробую покопаться, может открою новое для себя.
Идея есть следующая, делать ширину Рисунка по Ширине страницы. Вот только как будет соблюдаться пропорция по вертикали?

[VictorM]

необходимо создать макрос

А макрорекордером не пытались воспользоваться?

[Busine2009]

VictorM
а ты?

[VictorM]

Busine2009 я им пользуюсь регулярно, когда возникают какие-либо вопросы.
Много интересного можно увидеть в коде))

[Busine2009]

VictorM
поиграйся с Макрорекордером по поводу записывания Макросов для Рисунков, а именно по соблюдению пропорций - про это я писал, а не про твою находчивость.
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Вот попробуй:

Код: Выделить всё

Sub ImageDisign()
Dim oShape As Shape
Dim oInlineShape As InlineShape
Application.ScreenUpdating = False
For Each oShape In ActiveDocument.Shapes
    oShape.ConvertToInlineShape
Next
For Each oInlineShape In ActiveDocument.InlineShapes
    oInlineShape.Select
    oInlineShape.LockAspectRatio = msoTrue
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        If Selection.PageSetup.Orientation = wdOrientPortrait Then
            If oInlineShape.Width > Selection.PageSetup.PageWidth - _
                Selection.PageSetup.LeftMargin - Selection.PageSetup.RightMargin Then
                    vPriorWidth = oInlineShape.Width
                    vPriorHeight = oInlineShape.Height
                    oInlineShape.Width = Selection.PageSetup.PageWidth - _
                        Selection.PageSetup.LeftMargin - Selection.PageSetup.RightMargin
                oInlineShape.Height = vPriorHeight + oInlineShape.Width - vPriorWidth
            End If
        Else
            If oInlineShape.Height > Selection.PageSetup.PageHeight - _
                Selection.PageSetup.TopMargin - Selection.PageSetup.BottomMargin Then
                    vPriorWidth = oInlineShape.Width
                    vPriorHeight = oInlineShape.Height
                    oInlineShape.Height = Selection.PageSetup.PageHeight - _
                        Selection.PageSetup.TopMargin - Selection.PageSetup.BottomMargin
                oInlineShape.Width = vPriorWidth + oInlineShape.Height - vPriorHeight
            End If
        End If
Next
Application.ScreenUpdating = True
End Sub

[darklumen]

VictorM
поиграйся с Макрорекордером по поводу записывания Макросов для Рисунков, а именно по соблюдению пропорций - про это я писал, а не про твою находчивость.
--------------------------------------------------------------------------------
Добавлено сообщение
--------------------------------------------------------------------------------
Вот попробуй:

Код: Выделить всё

Sub ImageDisign()
Dim oShape As Shape
Dim oInlineShape As InlineShape
Application.ScreenUpdating = False
For Each oShape In ActiveDocument.Shapes
    oShape.ConvertToInlineShape
Next
For Each oInlineShape In ActiveDocument.InlineShapes
    oInlineShape.Select
    oInlineShape.LockAspectRatio = msoTrue
    Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
        If Selection.PageSetup.Orientation = wdOrientPortrait Then
            If oInlineShape.Width > Selection.PageSetup.PageWidth - _
                Selection.PageSetup.LeftMargin - Selection.PageSetup.RightMargin Then
                    vPriorWidth = oInlineShape.Width
                    vPriorHeight = oInlineShape.Height
                    oInlineShape.Width = Selection.PageSetup.PageWidth - _
                        Selection.PageSetup.LeftMargin - Selection.PageSetup.RightMargin
                oInlineShape.Height = vPriorHeight + oInlineShape.Width - vPriorWidth
            End If
        Else
            If oInlineShape.Height > Selection.PageSetup.PageHeight - _
                Selection.PageSetup.TopMargin - Selection.PageSetup.BottomMargin Then
                    vPriorWidth = oInlineShape.Width
                    vPriorHeight = oInlineShape.Height
                    oInlineShape.Height = Selection.PageSetup.PageHeight - _
                        Selection.PageSetup.TopMargin - Selection.PageSetup.BottomMargin
                oInlineShape.Width = vPriorWidth + oInlineShape.Height - vPriorHeight
            End If
        End If
Next
Application.ScreenUpdating = True
End Sub

ругается на эту строку oShape.ConvertToInlineShape

[Busine2009]

darklumen,
Значит у тебя есть Полотно в документе. Пока могу предложить только такое.
Добавь вот эту строчку сразу после Dim:

Код: Выделить всё

On Error Resume Next

В результате часть рисунков, оформленных в виде Полотна, будет пропущена, и их размер надо будет вручную менять.

[darklumen]

darklumen,
Значит у тебя есть Полотно в документе. Пока могу предложить только такое.
Добавь вот эту строчку сразу после Dim:

Код: Выделить всё

On Error Resume Next

В результате часть рисунков, оформленных в виде Полотна, будет пропущена, и их размер надо будет вручную менять.

у меня возникла другая проблема. Заголовок таблиц основан на стилях заголовках (заголовок 1, заголовок 2 и т.д)
а если у меня в тексте заголовки своим стилем оформлены, то вот такая ошибка:

Таблица Ошибка! Текст указанного стиля в документе отсутствует..3

[Busine2009]

darklumen
эта проблема связана с применением моего макроса?
Что-то не понятно ничего. Или у тебя вообще другая проблема возникла?
В таком случае, зачем цитату вставил?
Ничего не понимаю.
А что у тебя подразумевается под Заголовком таблицы? Текст над Таблицей или первая строка Таблицы?
И после каких манёвров появляется такая ошибка?