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

 obmen_soobsheniyami.png Чат для технических писателей 
 Зарегистрируйтесь
Страницы: 1 2 След.
RSS
Автонумерация рисунков
 
В уже готовом документе необходимо автоматически пронумеровать все рисунки (они уже выровнены по центру и имеют обтекание "в тексте"). Подскажите как?!

Раньше натыкалась на макрос, а теперь не могу его найти  :(  
Автоназвание тоже ни в какую не хочет работать.

Причем нумерацию потом обновлять не нужно будет! Просто один раз быстро пронумеровать и забыть.
 
Если Ваши рисунки еще не были нумерованы и не имеют названия, попробуйте использовать следующий макрос:


Код
Sub Numeration()
Dim a As Boolean    
a = True    
Selection.HomeKey Unit:=wdStory    
Selection.Find.ClearFormatting    
Selection.Find.Replacement.ClearFormatting    
Do While a = True     
With Selection.Find      
.Text = "^g"      
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindAsk      
.Format = False      
.MatchCase = False      
.MatchWholeWord = False      
.MatchWildcards = False      
.MatchSoundsLike = False      
.MatchAllWordForms = False     
End With     
Selection.Find.Execute     
a = Selection.Find.Found
'     MsgBox (a)     
If a = True Then      
Selection.InsertCaption Label:="Рис. ", TitleAutoText:="InsertCaption1", _          
      Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0      
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter     
End If    
Loop
End Sub
Изменено: Alex_Gur - 12.03.2014 09:14:56
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
При запуске макроса выскакивает ошибка "Run-time error '4198' Ошибка команды". И если нажать кнопку "Debug" то выделен следующий текст условия макроса:
Selection.InsertCaption Label:="?e`n~. ", TitleAutoText:="InsertCaption1", _
   Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0

Что не так?
 
Цитата
TechW пишет:
При запуске макроса выскакивает ошибка "Run-time error '4198' Ошибка команды". И если нажать кнопку "Debug" то выделен следующий текст условия макроса:
Selection.InsertCaption Label:="?e`n~. ", TitleAutoText:="InsertCaption1", _
   Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0

Что не так?

Там, вероятно, возникла ошибка при копировании макроса. Попробуйте заменить эти две строки на след.:

Selection.InsertCaption Label:="Рис. ", TitleAutoText:="InsertCaption1", _
   Title:="", Position:=wdCaptionPositionBelow, ExcludeLabel:=0
Изменено: Alex_Gur - 11.03.2014 15:52:46
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
Не помогло :( та же ошибка, опять эти строки не нравятся
 
Цитата
TechW пишет:
Не помогло   та же ошибка, опять эти строки не нравятся

К сожалению, не знаю в чем дело! У меня все работает.
Посмотрите мой контрольный пример - http://files.mail.ru/D966C74654724166BD0ACB3947CF065D.
Работает ли макрос у Вас на моем файле?
Должен пронумеровать все рисунки от 1 до 4.
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
Ошибка в том, что у TechW не создан объект автоназвания "Рис. ". Нужно либо создать такой объект, либо заменить в тексте макроса на "Рисунок".
Изменено: Nadufka - 11.03.2014 17:15:43
Работать надо не 12 часов, а головой.
 
Цитата
Nadufka пишет:
Ошибка в том, что у  TechW  не создан объект автоназвания "Рис. ". Нужно или создать такой объект, либо заменить в тексте макроса на "Рисунок".

Спасибо, Nadufka, я об этом не подумал.
TechW, В реальности, нужно сюда вставить тот объект автоназвания рисунка, который Вы используете для нумерации. У меня это - "Рис. "
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
Да нет, объект Рис. у меня есть. На всякий случай ставила и Рисунок и Figure в текст макроса -ничего не меняется.

Да и с примером Alex_Gur та же беда http://yadi.sk/d/eCtZ4JVzKKs7g .

Наверное я что-то не так делаю в Visual Basic Editor. Это мой первый макрос  :oops:  . Вот, по скриншотам ошибку не видно, случайно? вдруг что-то не туда копирую?!   :|    http://yadi.sk/d/hnfD-gE7KKs7S

Кстати, если, изначально,  я прикрепляю макрос к файлу ThisDocument  (см. рисунок), а не к отдельному модулю, то выскакивает другая ошибка http://yadi.sk/d/uT25KggcKKto9
Изменено: TechW - 11.03.2014 17:54:52
 
У меня тоже макрос не работает, в контрольном примере в том числе. Ошибка не выходит, но рисунки не нумеруются...
 
Тогда попробуйте выполнить автозапись макроса нумерации одного рисунка и вставить соответствующую строку вместо той, которая у Вас не работает.
Интересно, какой вид у Вас будет иметь эта строка?
Сообщите нам, пожалуйста.
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
У меня все работает, такая ошибка выскакивает только в случае, если не совпадает название автонумерации.

TechW , а какая у Вас версия Word? И точно название имеет вид "Рис. " с пробелом после точки?
Работать надо не 12 часов, а головой.
 
Всё работает! У меня действительно не было пробела после "Рис." - в этом все дело.

Спасибо большое  :D
 
А если усложнить задачу?! Что если часть объектов уже имеют название - диаграмма (имеют вою нумерацию) - можно их исключить из нумерации?
 
Цитата
TechW пишет:
А если усложнить задачу?! Что если часть объектов уже имеют название - диаграмма (имеют вою нумерацию) - можно их исключить из нумерации?
Тогда попробуйте применить следующий макрос, который я преобразовал из опубликованного на странице http://www.msofficeforums.com/word-vba/11229-vba-insert-captions-without-appending-existing-captions.html


Код
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
End Sub
 
Изменено: Alex_Gur - 12.03.2014 12:28:13
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
Тоже работает (заменив Label:="Ðèñ. " на Label:="Рис."). Но диаграммы также нумеруются. Дело в том, что они как объекты word - рисунки, под которыми обычным стилем названия жирным шрифтом написаны (документ выгружается из другой программы). А можно такое условие создать "если под рисунком слово Диаграмма, то его не нумеровать"?!

Попробую ещё стиль наименования диаграммы изменить в исходной программе.
 
Добавила удаление названия перед словом "Диаграмма" и обновление полей.
Код
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
 
Изменено: Nadufka - 12.03.2014 11:44:50
Работать надо не 12 часов, а головой.
 
Чудеса! Все работает, спасибо.
Макросы - это интересно.
 
Здравствуйте!
Извините за офф топ: вопрос насущный.

Набираю текст по химии, мне нужна стрелка с надпись сверху и снизу, а так же подпись под хим. формулой.

Вставка - формулы - оператор - там есть стрелка с окошком для текста только сверху или снизу. Так же стрелка-оператор есть в Вставка - объект - ME 3.0.

Для подписи, например дробь, делит строку пополам, а мне нужно что бы верхняя строка (то есть формула) была на уровне всей строки, а подпись под ней.

Спасибо заранее за помощь!

PS. модераторы, переместите (при необходимости) мое сообщение в соответствующую (или новую) тему.
Изменено: vard-hakop - 11.04.2014 16:03:01
 
Цитата
vard-hakop пишет:
Здравствуйте!
Извините за офф топ: вопрос насущный.

Набираю текст по химии, мне нужна стрелка с надпись сверху и снизу, а так же подпись под хим. формулой.

Вставка - формулы - оператор - там есть стрелка с окошком для текста только сверху или снизу. Так же стрелка-оператор есть в Вставка - объект - ME 3.0.

Для подписи, например дробь, делит строку пополам, а мне нужно что бы верхняя строка (то есть формула) была на уровне всей строки, а подпись под ней.

Спасибо заранее за помощь!
Предлагаю Вам возможный вариант решения - с помощью объекта Надпись (http://yadi.sk/d/155M9zlEMFuWb).
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
спасибо! буду пробовать этот способ!

а готовых схем (как, например, операторы) нет, Вы не знаете? может я плохо искал..
 
Еще можно сделать так: http://yadi.sk/d/uSCh7708MG36k (в этом случае используются оператор с надписью над стрелочкой и объект Надпись).
Изменено: Alex_Gur - 11.04.2014 16:50:09
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
 
Цитата
Alex_Gur пишет:
Еще можно сделать так: http://yadi.sk/d/uSCh77
ссылка, к сожалению, не открылась This link was removed or not found.
Но по описанию, я именно так и делаю сейчас, после вашего первого сообщения.
Изменено: vard-hakop - 11.04.2014 16:29:34
 


спасибо, вы мне очень помогли
Изменено: vard-hakop - 11.04.2014 16:42:10
 
Цитата
vard-hakop пишет:
Цитата
Alex_Gur пишет:
Еще можно сделать так: http://yadi.sk/d/uSCh77
ссылка, к сожалению, не открылась This link was removed or not found.
Но по описанию, я именно так и делаю сейчас, после вашего первого сообщения.
Прошу прощения, ссылка скопировалась не полностью. Надо: http://yadi.sk/d/uSCh7708MG36k
Если у вас появятся вопросы, пожалуйста, обращайтесь - будем думать вместе!
Страницы: 1 2 След.
Читают тему