Как в ворде сделать уголок

Добавлено: 28.01.2018, 09:13 / Просмотров: 55444

Штатными средствами это сделать не получится. Можно, конечно, поместить пустое текстовое поле в колонтитул, и оно будет отображаться на каждой странице. Но текст вокруг него обтекать не будет. Могу предложить такой макрос:

Код:

Sub InsertBlankFieldToTopRightConerOfEveryPage() Dim PagesCount%, i%, oRng As Range, iLeft#, DocUnit% 'Определяем количество страниц в документе PagesCount = ActiveDocument.Content.ComputeStatistics(wdStatisticPages) Set oRng = ActiveDocument.Content 'Переводим единицы измерения в точки DocUnit = Options.MeasurementUnit: Options.MeasurementUnit = wdPoints For i = 1 To PagesCount 'Считаем положение правого верхнего угла страницы With oRng.Sections(1).PageSetup iLeft = .PageWidth - .LeftMargin - .RightMargin End With 'Добавляем текстовое поле With ActiveDocument.Shapes.AddTextbox _ (msoTextOrientationHorizontal, _ iLeft - CentimetersToPoints(1), _ 0, _ CentimetersToPoints(1), _ CentimetersToPoints(0.5), _ oRng) 'Имя фигуры, чтобы можно было ее удалить не трогая другие. .Name = "Blank" & i 'Убираем у поля границы .Line.Visible = False 'Ставим привязку к странице .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage .RelativeVerticalPosition = wdRelativeVerticalPositionPage 'Устанавливаем обтекание текстом With .WrapFormat .AllowOverlap = True .DistanceBottom = 0: .DistanceLeft = 3: .DistanceRight = 0: .DistanceTop = 0 .Type = wdWrapSquare: .Side = wdWrapLeft End With End With 'Переходим на следующую страницу Set oRng = oRng.GoToNext(1) 'wdGoToPage Next i 'Восстанавливаем единицы измерения. Options.MeasurementUnit = DocUnit End Sub Единственное требование: этот макрос нужно применять только после всех операций с текстом. Если количество страниц будет меняться или сметится первый абзац любой страницы, то все поля нужно будет удалить и запустить макрос снова.
Добавлено позже
После вставки строк, выделенных жирным, можно добавлять абзацы и поле смещаться не будет. Но при добавлении страницы, придется запустить макрос снова, предварительно удалив все уголки.
Добавлено еще позднее
А этот макрос удалит все наши фигуры.

Код:

Sub RemoveBlankFieldFromTheTopRightConerOfEveryPage() Dim i% For i = ActiveDocument.Shapes.Count To 1 Step -1 If ActiveDocument.Shapes(i).Name Like "Blank" Then _ ActiveDocument.Shapes(i).Delete Next i End Sub

__________________
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 06.04.2009 в 16:57.


Источник: http://www.programmersforum.ru/showthread.php?t=44583


Поделись с друзьями



Рекомендуем посмотреть ещё:


Закрыть ... [X]

Уголки в Ворде Полезное программное обеспечение. Аллея Бродяги Имя для девочки своими руками


Как в ворде сделать уголок Как в ворде сделать уголок Как в ворде сделать уголок Как в ворде сделать уголок Как в ворде сделать уголок Как в ворде сделать уголок

ШОКИРУЮЩИЕ НОВОСТИ


Back to Top