![]() |
|
#1
|
||||
|
||||
![]()
For example:
Code:
Sub Demo() Application.ScreenUpdating = False Dim s As Long, HdFt As HeaderFooter, Shp As Shape, Rng As Range With ActiveDocument For s = 1 To .Sections.Count Select Case s Case 1 For Each HdFt In .Sections(s).Headers With HdFt If .Exists Then If Shp Is Nothing Then Set Rng = .Range.Characters.First: Rng.Collapse wdCollapseStart Set Shp = .Shapes.AddTextbox(Orientation:=msoTextOrientationHorizontal, _ Left:=50, Top:=50, Width:=460, Height:=120, Anchor:=Rng) With Shp With .Line .DashStyle = msoLineSolid .Style = msoLineSingle .Transparency = 0# .Visible = msoFalse End With With .TextFrame With .TextRange .Text = "PROJET" .Font.Name = "Arial Black" .Font.Size = 100 .Font.Color = -603923969 End With .MarginLeft = 0# .MarginRight = 0.5 .MarginTop = 0# .MarginBottom = 0# End With .Left = wdShapeRight .WrapFormat.Type = wdWrapBehind .Rotation = 315 .LockAspectRatio = True .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage .RelativeVerticalPosition = wdRelativeHorizontalPositionPage .Top = 400 .Left = 125 .LockAnchor = True End With Else Set Rng = .Range.Characters.First: Rng.Collapse wdCollapseStart Rng.FormattedText = Shp.Anchor.FormattedText End If End If End With Next Case Else For Each HdFt In .Sections(s).Headers With HdFt If .Exists Then If .LinkToPrevious = False Then Set Rng = .Range.Characters.First: Rng.Collapse wdCollapseStart Rng.FormattedText = Shp.Anchor.FormattedText End If End If End With Next End Select Next End With Set Rng = Nothing: Set Shp = Nothing Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
When I copy a shape into another document it becomes a picture. I want a shape. | FJM | Word | 4 | 02-24-2022 09:59 AM |
Visio 2016 New homemade Shape Data export with Network Shape Data | Karlderxte | Visio | 1 | 08-17-2021 04:04 PM |
Fit text to shape / Place table in shape | Floppy | PowerPoint | 0 | 04-01-2021 11:01 AM |
Word Mac 2010 VBA Draw shape shortcut, irregular shape, draw without graphics tablet like in paint | AnonA2 | Word VBA | 0 | 11-24-2020 04:21 PM |
How to change size / shape of a shape in a stencil | tomgoodell | Visio | 1 | 06-30-2016 04:40 AM |