Re: Макрос в word - форматирование рисунков
Добавлено: 25 дек 2009, 19:57
Busine2009 писал(а):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