#1
|
|||
|
|||
Add Shape on every Header of each Section
Hi!
The following code adds a TextBox on each Header of each Section. It works fine as long as there is no continuous section brakes. When there are continuous section brakes, the code inserts as many TextBoxes as there is continuous section brakes + one more TextBox, and does that on the following section! So, on my first page, I have 2 continuous sections brakes + 1 section next page = I get on the first page ONE text box, and on the second page FOUR text boxes! What should I change? Code:
Sub MyMacro() Dim oSection As Section Dim oHeader As HeaderFooter Dim Boite As Shape For Each oSection In ActiveDocument.Sections For Each oHeader In oSection.Headers If oHeader.Exists Then Set Boite = oHeader.Shapes.AddTextBox( _ Orientation:=msoTextOrientationHorizontal, _ Left:=50, Top:=50, Width:=460, Height:=120) With Boite .TextFrame.TextRange.Text = "PROJET" .TextFrame.TextRange.Font.Name = "Arial Black" .TextFrame.TextRange.Font.Size = 100 .TextFrame.TextRange.Font.Color = -603923969 .TextFrame.MarginLeft = 0# .TextFrame.MarginRight = 0.5 .TextFrame.MarginTop = 0# .TextFrame.MarginBottom = 0# .Line.DashStyle = msoLineSolid .Line.Style = msoLineSingle .Line.Transparency = 0# .Line.Visible = msoFalse .Left = wdShapeRight .WrapFormat.Type = wdWrapBehind .Rotation = 315 .LockAspectRatio = True .RelativeHorizontalPosition = wdRelativeHorizontalPositionPage .RelativeVerticalPosition = wdRelativeHorizontalPositionPage .Top = 400 .Left = 125 End With End If Next oHeader Next oSection End Sub Souriane Last edited by Souriane; 12-05-2022 at 01:22 PM. Reason: Edited My title, it was uncompleted |
#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] |
#3
|
||||
|
||||
Using shapes rather than inline shapes is a problem in headers. See this thread for discussions on where the problems are that you will encounter.
https://www.msofficeforums.com/word-...en-though.html Is there a reason your layout can't use an inline table instead of a text box? I would recommend you explore any options to avoid floating shapes first.
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#4
|
|||
|
|||
@Guessed: had never understood the difference between Shapes and InlineShapes. Went to read on the subject and it make alot of sense with my problem (and a few others I had in the past)! Thank you so much!
@Macropod: the code works great except the shapes do not rotate. Can't figure out why. I tried changing a few things in the code and nope. But if I do it manually on the shape, after the code, it works. So the shapes are note "broken" If you don't know, I will work to change the code from Shapes to InlineShape as Guessed suggested. And thanks again to both of you!! You really helped me today and many many other times! Souriane |
#5
|
||||
|
||||
Quote:
InlineShapes can't be rotated.
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#6
|
|||
|
|||
>> Have you tried re-starting Word/Windows?
That was the solution! Thank you very much for your time! Have a nice day! |
Thread Tools | |
Display Modes | |
|
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 |