Отправляет email-рассылки с помощью сервиса Sendsay

VBA tips - подсказки и решения на VBA

Рассылка закрыта

При закрытии подписчики были переданы в рассылку "Свой Бизнес" на которую и рекомендуем вам подписаться.

Вы можете найти рассылки сходной тематики в Каталоге рассылок.

←   Июль 2009   →
 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Автор
alex.viter

Статистика

522 подписчиков
0 за неделю
←   Все выпуски   →

VBA tips - подсказки и решения на VBA


Нумерация формул в документе

В бытность мою студентом мы нумеровали формулы вручную. Не стоит и говорить, сколько сил и энергии занимало это непочтенное занятие. Теперь я предлагаю Вашему вниманию два макроса: один из которых вставляет в документ объект MS Equation с автоматической нумерацией, а второй нумерует уже существующие в документе формулы.

Итак, вставка формулы с автоматической нумерацией:

00001 'Вставка формулы с нумерацией
00002 Sub InsertEquation()
00003   Dim oRng As Range
00004   Set oRng = Selection.Range
00005   With oRng.ParagraphFormat
00006     .SpaceAfterAuto
= False: .SpaceBeforeAuto = False
00007     .FirstLineIndent = 0
00008 
   .TabStops.ClearAll
00009     .TabStops.Add (Selection.Sections(1).PageSetup.PageWidth - _
00010                    Selection.Sections(1).PageSetup.LeftMargin - _
00011                    Selection.Sections(1).PageSetup.RightMargin - _
00012                    .LeftIndent - .RightIndent) / 2, _
00013                    wdAlignTabCenter, wdTabLeaderSpaces
00014   
 .TabStops.Add Selection.Sections(1).PageSetup.PageWidth - _
00015                
  Selection.Sections(1).PageSetup.LeftMargin - _
00016                   Selection.Sections(1).PageSetup.RightMargin - _
00017                   .LeftIndent - .RightIndent, _
00018
                  wdAlignTabRight, wdTabLeaderSpaces
00019   End With
00020   With oRng
00021     .InsertBefore vbTab
00022  
  .Collapse wdCollapseEnd
00023     .InsertParagraphAfter
00024     .Select
00025     With Selection
00026
      .InsertStyleSeparator
00027       .TypeText vbTab & "("
00028       'Нумерация с помощью поля последовательной нумерации
00029
      .Fields.Add .Range, wdFieldEmpty, "SEQ formula", True
00030       'Нумерация с помощью вставки названия
00031 '      .InsertCaption "Формула", "", "InsertCaption1", wdCaptionPositionAbove, 1
00032       .TypeText ")"
00033     End With
00034     .InlineShapes.AddOLEObject "Equation.3", "", False,
False, Range:=oRng
00035     .InlineShapes(1).Select
00036   End With
00037 End Sub

Нумерация формул, уже вставленных в документ

00001 Sub NumberEquation()
00002   Dim oIShape As InlineShape
00003   Dim oRng As Range
00004   For Each oIShape In ActiveDocument.InlineShapes
00005     If oIShape.OLEFormat.ClassType = "Equation.3" Then
00006       Set oRng = oIShape.Range
00007       With oRng.ParagraphFormat
00008         .SpaceAfterAuto = False: .SpaceBeforeAuto = False
00009         .FirstLineIndent = 0
00010         .TabStops.ClearAll
00011         .TabStops.Add (ActiveDocument.PageSetup.PageWidth - ActiveDocument.PageSetup.LeftMargin - ActiveDocument.PageSetup.RightMargin - .LeftIndent - .RightIndent) / 2, _
00012                       wdAlignTabCenter, wdTabLeaderSpaces
00013         .TabStops.Add ActiveDocument.PageSetup.PageWidth - ActiveDocument.PageSetup.LeftMargin - ActiveDocument.PageSetup.RightMargin - .LeftIndent - .RightIndent, _
00014                       wdAlignTabRight, wdTabLeaderSpaces
00015       End With
00016       With oRng
00017         .InsertBefore vbTab
00018         .Collapse
wdCollapseEnd
00019         .InsertParagraphAfter
00020         .Select
00021         With Selection
00022           .InsertStyleSeparator
00023           .Font.Bold = True
00024           .TypeText vbTab & "("
00025           .Fields.Add .Range, wdFieldSequence, "formula", True
00026
          .TypeText ")"
00027         End With
00028       End With
00029     End If
00030   Next oIShape
Последний макрос работает со всеми объектами MS Equation, вставленными в документ. Поэтому будьте осторожны. Если у вас в документе присутствуют другие объекты MS Equation, которые не должны нумероваться, то результат может вас разочаровать.
В избранное