![]() |
|
#2
|
||||
|
||||
|
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] |
|
|
Similar Threads
|
||||
| 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 |