Страница 1 из 2

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

Добавлено: 09 дек 2009, 18:48
darklumen
здравствуйте.
есть текст - в нем много рисунков, оформленных хаотично, т.е некоторые рисунки выходят за пределы страницы, некоторые выровнены по ширине, другие по левому краю.

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

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

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

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

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

Добавлено: 10 дек 2009, 09:21
VictorM
необходимо создать макрос
А макрорекордером не пытались воспользоваться?

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

Добавлено: 10 дек 2009, 19:57
Busine2009
VictorM
а ты?

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

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

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

Добавлено: 10 дек 2009, 22:08
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

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

Добавлено: 20 дек 2009, 15:55
darklumen
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

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

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

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

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

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

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

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

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

On Error Resume Next
В результате часть рисунков, оформленных в виде Полотна, будет пропущена, и их размер надо будет вручную менять.
у меня возникла другая проблема. Заголовок таблиц основан на стилях заголовках (заголовок 1, заголовок 2 и т.д)
а если у меня в тексте заголовки своим стилем оформлены, то вот такая ошибка:

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

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

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