Consulting

Results 1 to 2 of 2

Thread: Merging two new shapes

  1. #1
    VBAX Regular
    Joined
    Dec 2018
    Posts
    24
    Location

    Merging two new shapes

    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

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,093
    Location
    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
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •