PDA

View Full Version : Merging two new shapes



StarPig
01-26-2019, 09:40 AM
Hello. I am finding it difficult to work out how to insert two new shapes with text, as shown below, but with these then grouped.

Can you help please? Thank you.


Sub HeadingSingle()


Set B = ActiveWindow.View.Slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 45.5, 109.7, 725, 400)
With B.TextFrame2
.MarginTop = 0
.MarginBottom = 0
.MarginLeft = 0
.MarginRight = 0
.VerticalAnchor = msoAnchorBottom
With .TextRange
.Text = "Heading Text"
.ParagraphFormat.Alignment = msoAlignLeft
With .Font
.Name = "Arial"
.Size = "12"
End With
End With


Set myDocument = ActivePresentation.Slides(1)
Set C = ActiveWindow.View.Slide.Shapes.AddLine(45.5, 127, 770, 127).Line
With C
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 1
End With
End With

With myDocument.Shapes
With .Range(Array("B", "C")).Group
.Fill.PresetTextured msoTextureBlueTissuePaper
.Rotation = 45
.ZOrder msoSendToBack
End With
End With



End Sub

John Wilson
01-27-2019, 05:36 AM
The Array has to be the NAME of the added shapes.


Sub HeadingSingle()
' ALWAYS DECLARE YOUR VARIABLES!
Dim B As Shape
Dim C As Shape
Dim myDocument As Slide
Dim lineTop As Single
Set B = ActiveWindow.View.Slide.Shapes.AddTextbox(msoTextOrientationHorizontal, 45.5, 109.7, 725, 400)
With B.TextFrame2
.MarginTop = 0
.MarginBottom = 0
.MarginLeft = 0
.MarginRight = 0
.VerticalAnchor = msoAnchorBottom
With .TextRange
.Text = "Heading Text"
'This is how to place the line under the text
lineTop = .BoundHeight + .BoundTop
.ParagraphFormat.Alignment = msoAlignLeft
With .Font
.Name = "Arial"
.Size = "12"
End With
End With
Set myDocument = ActivePresentation.Slides(1)
Set C = ActiveWindow.View.Slide.Shapes.AddLine(45.5, lineTop, 770, 127)
With C.Line
.ForeColor.RGB = RGB(0, 0, 0)
.Weight = 1
End With
End With
With myDocument.Shapes
' to create the array use the NAME of the shape
With .Range(Array(B.Name, C.Name)).Group
.Fill.PresetTextured msoTextureBlueTissuePaper
.Rotation = 45 ' This is going to be off slide BTW!
.ZOrder msoSendToBack
End With
End With
End Sub