Разработка технической документации и технические писатели Технические писатели и разработка технической документации технические писатели в Телеграм 

 obmen_soobsheniyami.png Чат для технических писателей 
 Зарегистрируйтесь
Страницы: 1
RSS
Макрос нумерации рисунков (с исключениями)
 
Я давно использую макрос, который создали  пользователи форума. Это макрос для автоматической нумерации рисунков, за исключением тех, под которыми есть надпись - Диаграмма.
Вот он:
Код
Sub FindUncaptionedShape()
Dim oCap As CaptionLabel, iShp As InlineShape, TmpRng As Range, TmpStr As String
For Each oCap In CaptionLabels
  TmpStr = TmpStr & CaptionLabels(oCap) & " "
Next
    Selection.HomeKey Unit:=wdStory
With ActiveDocument
  For Each iShp In .InlineShapes
    Set TmpRng = iShp.Range.Words.Last
    With TmpRng
      Do While Len(.Text) = 1
        .MoveEnd wdWord, 1
        .MoveStart wdWord, 1
      Loop
      
      If InStr(TmpStr, .Text) = 0 Then
        iShp.Range.InsertCaption Label:="Рис.", TitleAutoText:="InsertCaption1", _
                Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
            Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
      End If
    End With
  Next
End With
Dim b As Boolean
b = True
    Selection.Find.ClearFormatting
    Selection.Find.Replacement.ClearFormatting
Do While b = True
    With Selection.Find
        .Text = "^pДиаграмма"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindAsk
        .Format = False
        .MatchCase = True
        .MatchWholeWord = False
        .MatchWildcards = False
        .MatchSoundsLike = False
        .MatchAllWordForms = False
    End With
    Selection.Find.Execute
b = Selection.Find.Found
If b = True Then
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.HomeKey Unit:=wdLine
    Selection.EndKey Unit:=wdLine, Extend:=wdExtend
    Selection.Delete Unit:=wdCharacter, Count:=1
End If
Loop
    Selection.WholeStory
    Selection.Fields.Update
End Sub
 
А теперь прошу помощи добавить ещё одно исключение: если рисунки идут подряд (между ними и пробела нет), то нумеровать следует только последний рисунок.
Подскажите пожалуйста
Страницы: 1
Читают тему