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

[darklumen]

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

прошу прощения, не в ту тему написал.
у меня совершенно другой вопрос был: я добавил в ваш код возможность вставки названия рисунков после самих рисунков., можно ли создать условие при котором, если имеется уже рисунок у картинки, то поле просто обновлялось бы, а если нет - то название картинки вставлялось бы.


Sub ImageDisign()
Dim oShape As Shape
Dim oInlineShape As InlineShape
Application.ScreenUpdating = False
For Each oShape In ActiveDocument.Shapes
If oShape.Type = msoPicture Then
oShape.ConvertToInlineShape
End If
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

With CaptionLabels("Ðèñóíîê")
.NumberStyle = wdCaptionNumberStyleArabic
.IncludeChapterNumber = True
.ChapterStyleLevel = 1
.Separator = wdSeparatorPeriod
End With

Selection.InsertCaption Label:="Ðèñóíîê", TitleAutoText:="InsertCaption1", _
Title:="", Position:=wdCaptionPositionBelow ', ExcludeLabel:=0

ActiveWindow.ActivePane.SmallScroll Down:=15
Selection.Find.Execute Replace:=wdReplaceAll


Next
Application.ScreenUpdating = True
End Sub

[Busine2009]

Напиши, что тебе конкретно нужно, только не цитируй меня.
Я так понимаю, что тебе нужно вставлять после рисунков Название (вставка - ссылка - название), а если есть уже Название, то обновлять его номер?
У тебя Название сразу идёт после Рисунка или есть пустой абзац?

Чтобы не было стриказябликов:
1 вариант - менять язык клавиатуры перед копированием (точно не помню, то ли на русский, то ли на английский).
2 вариант:
Скопируй это в текстовый файл, сохрани с расширением reg и запусти этот файл

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Nls\CodePage]
"1250"="c_1251.nls"
"1251"="c_1251.nls"
"1252"="c_1251.nls"
Затем перезагрузи компьютер

3 вариант - зайди в реестр и вручную поменяй (я так сделал у себя). Перезагрузи компьютер.

[darklumen]

1) Нужно вставлять после рисунков Название (вставка - ссылка - название), а если есть уже Название, то обновлять его номер.
2) Название вставляется сразу после Рисунка.

на краказябрики не обращай внимания, я просто показал, что в ваш код вставил пару строчек, которые вставляют название. =)))

[Busine2009]

Я попробую это сделать, но у меня есть предложение.
Если ты сам вставляешь Рисунки в документы, то можно сделать так, чтобы Названия вставлялись автоматически при их вставке. Если же ты работаешь с документами, сделанными другими людьми, тогда только Макрос (а может и не только).
Вот как делается автоматическая вставка Названий:
Вставка - Ссылка - Название - Автоназвание - Microsoft Word Picture - выбираешь или создаёшь "Подпись".

[Busine2009]

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

Sub Picture_2()
Dim oInlineShape As InlineShape
Dim oField As Field
Dim oFieldTrue As Long
CaptionLabels.Add Name:="Рисунок"
For Each oInlineShape In ActiveDocument.InlineShapes
    oInlineShape.Select
    Selection.MoveDown
    Selection.Paragraphs(1).Range.Select
    If Selection.Fields.Count > 0 Then
        For Each oField In Selection.Fields
            If oField.Type = wdFieldSequence Then
                oField.Update
                oFieldTrue = 1
            End If
        Next
    End If
    If oFieldTrue = 0 Then
        Selection.MoveUp
        Selection.InsertAfter Chr(13)
        Selection.MoveDown
        Selection.InsertCaption Label:="Рисунок"
    End If
oFieldTrue = 0
Next
End Sub

Запускай его после того макроса.
Если будешь использовать отдельно от того макроса, то переведи сначала Рисунки в InlineShape.

[darklumen]

спасибо огромное! очень помогла ваша помощь! =)) спасибо! =)))