Статьи из блога

Задать обтекание текстом для всех рисунков в документе

Вопрос от Макса:

Нужно в документе WORD сделать обтекание текстом ВСЕХ рисунков. Как это сделать? По одному делается без проблем, но их очень много, а всех вместе никак...

Попробуйте такой макрос (на копии документа - на всякий случай):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Sub wrapImages()
'Обтекание текстом для всех типов графических объектов
Dim pic As Object
On Error Resume Next
For Each pic In ActiveDocument.Content.InlineShapes
  If pic.Type = wdInlineShapePicture Then
   pic.InlineShapes(1).ConvertToShape
   pic.ShapeRange.WrapFormat.Type = wdWrapTight
  End If
Next
For Each pic In ActiveDocument.Content.ShapeRange
  If pic.Type = msoPicture Then
   pic.ShapeRange.WrapFormat.Type = wdWrapSquare
  End If
Next
End Sub

Рубрика: Вопрос-Ответ, Макросы, Стили и форматирование
Метки: |
Просмотров: 21897
Подписаться на комментарии по RSS
Версия для печати

[Ссылки на статью]

twitter.com facebook.com vkontakte.ru odnoklassniki.ru mail.ru ya.ru rutvit.ru myspace.com technorati.com digg.com friendfeed.com pikabu.ru blogger.com liveinternet.ru livejournal.ru memori.ru google.com bobrdobr.ru mister-wong.ru yahoo.com yandex.ru del.icio.us

Еще записи по вопросам использования Microsoft Word:

Комментариев: 2

  1. jarslav
    24.11.2010 в 11:27 | #1

    Это особенно полезно при импортировании фрагментов документа из Open Office в Microsoft Word. При импортировании посредством обычной вставки и ипользования стилей конечного документа обтекание всех рисунков почему-то съезжает из В тексте в Вокруг рамки. Действительно для Microsoft Word 2007 и Open Office 3.2 (шаблон докмуента создавался в Word и редактировался в Open Office, после чего обратно импортировался в Word).

  2. jarslav
    24.11.2010 в 16:57 | #2

    Мой вариант:

    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    15
    16
    17
    18
    19
    20
    21
    22
    23
    24
    Sub ImageWrapFormatBugFix()
    '
    ' ImageWrapFormatBugFix Macro
    '
    '
    Dim Promt, Style, Title, Help, Ctxt, Response, MyString
    Promt = "This macro fixes a bug with wrapping patterns arising when importing data from a document Open Office. Do you want to continue?" + vbCrLf + vbCrLf + "NB: Do not run this macro more than once."
    Style = vbYesNo + vbCritical + vbDefaultButton2
    Title = "Wrapping patterns FIX"
    Response = MsgBox(Promt, Style, Title + " Welcome")
    If Response = vbNo Then
        Exit Sub
    End If
    Dim Msg
    Msg = "Shapes in current document:" + vbCrLf
    Msg = "Name" + vbTab + vbTab + "Current" + vbTab + "Fixed" + vbCrLf
    Dim img As Object
    For Each img In ActiveDocument.Content.ShapeRange
        Msg = Msg + img.Name + vbTab + CStr(img.WrapFormat.Type)
        img.WrapFormat.Type = wdWrapInline
        Msg = Msg + vbTab + CStr(img.WrapFormat.Type) + vbCrLf
    Next
    Response = MsgBox(Msg, vbInformation, Title + " Results")
    End Sub

Оставьте комментарий!

(обязательно)

контакты

 
^ Наверх