How to format powerpoint text box in visual basic

8.5k views Asked by At

I'm using Visual Basic in PowerPoint 2010 and I'm writing a script to import a set of pictures to a slide and create text boxes

I'm having trouble formatting the text boxes correctly. How can I:

  • set opaque white fill
  • set bold black text
  • set 2 pt black border

Below is my sample subprocess:

    Sub import_pics()


    ' --------------------------------------------------------------------------------------------------- '
    ' --------------------------------- set the slide layout parameters --------------------------------- '
    ' --------------------------------------------------------------------------------------------------- '

    slide_width_in = 10
    slide_height_in = 6.25

    slide_width_pt = slide_width_in * 72
    slide_height_pt = slide_height_in * 72

    banner_height_pct = 0.17
    banner_height_pt = (slide_height_pt * banner_height_pct)

    footer_height_pct = 0.05
    footer_height_pt = (slide_height_pt * footer_height_pct)

    side_margin_pct = 0.02
    side_margin_pt = (slide_width_pt * side_margin_pct)

    top_bottom_margin_pct = 0.02
    top_bottom_margin_pt = ((slide_height_pt - banner_height_pt - footer_height_pt) * top_bottom_margin_pct)

    num_pic_columns_on_slide = 2
    pic_default_width_pt = ((slide_width_pt - 2 * side_margin_pt) / num_pic_columns_on_slide) - (2 * side_margin_pt)

    pic_default_aspect_ratio = 718 / 1000
    pic_default_height_pt = pic_default_width_pt * pic_default_aspect_ratio

    intended_pic_rows = 2
    maximum_allowed_height_of_pic = ((slide_height_pt - banner_height_pt - footer_height_pt) / intended_pic_rows) - (2 * top_bottom_margin_pt)

    If pic_default_height_pt > maximum_allowed_height_of_pic Then
        pic_default_height_pt = maximum_allowed_height_of_pic
        pic_default_width_pt = maximum_allowed_height_of_pic * (1 / pic_default_aspect_ratio)
    End If

    pic_1_top = banner_height_pt + 1 * top_bottom_margin_pt
    pic_2_top = banner_height_pt + 1 * top_bottom_margin_pt
    pic_3_top = banner_height_pt + 3 * top_bottom_margin_pt + (1 * pic_default_height_pt)
    pic_4_top = banner_height_pt + 3 * top_bottom_margin_pt + (1 * pic_default_height_pt)

    pic_1_left = 1 * side_margin_pt
    pic_2_left = 3 * side_margin_pt + (1 * pic_default_width_pt)
    pic_3_left = 1 * side_margin_pt
    pic_4_left = 3 * side_margin_pt + (1 * pic_default_width_pt)

    Dim slideObject As Slide
    Dim longSlideCount As Long

    ' --------------------------------------------------------------------------------------------------- '
    ' --------------------------------- construct the slide --------------------------------------------- '
    ' --------------------------------------------------------------------------------------------------- '

    longSlideCount = ActivePresentation.Slides.Count

    With ActivePresentation.Slides
        Set slideObject = .Add(longSlideCount + 1, ppLayoutTitleOnly)
    End With

    slideObject.Shapes.Title.TextFrame.TextRange.Text = "Slide 1"

    Set tbox1 = slideObject.Shapes.AddTextbox( _
                Orientation:=msoTextOrientationHorizontal, _
                Left:=100, _
                Top:=250, _
                Width:=72, _
                Height:=50).TextFrame.TextRange



    tbox1.Text = "hello"
    tbox1.Font.Bold = msoTrue
    tbox1.Font.Name = "Calibri"
    tbox1.Font.Size = 10
    tbox1.ParagraphFormat.Alignment = ppAlignCenter

    ' --------------------------------------------------------------------------------------------------- '

    ' how can I set the text box to have:
    '  --> opaque white fill
    '  --> bold black text
    '  --> 2 pt black border

    ' --------------------------------------------------------------------------------------------------- '

    Set pic1 = slideObject.Shapes.AddPicture( _
   FileName:="sample_pic1.png", _
   LinkToFile:=msoFalse, _
   SaveWithDocument:=msoTrue, Left:=pic_1_left, Top:=pic_1_top)

   pic1.LockAspectRatio = msoTrue
   pic1.Width = pic_default_width_pt

    Set pic2 = slideObject.Shapes.AddPicture( _
   FileName:="sample_pic2.png", _
   LinkToFile:=msoFalse, _
   SaveWithDocument:=msoTrue, Left:=pic_2_left, Top:=pic_2_top)

   pic2.LockAspectRatio = msoTrue
   pic2.Width = pic_default_width_pt

    Set pic3 = slideObject.Shapes.AddPicture( _
   FileName:="sample_pic3.png", _
   LinkToFile:=msoFalse, _
   SaveWithDocument:=msoTrue, Left:=pic_3_left, Top:=pic_3_top)

   pic3.LockAspectRatio = msoTrue
   pic3.Width = pic_default_width_pt

    Set pic4 = slideObject.Shapes.AddPicture( _
   FileName:="sample_pic4.png", _
   LinkToFile:=msoFalse, _
   SaveWithDocument:=msoTrue, Left:=pic_4_left, Top:=pic_4_top)

   pic4.LockAspectRatio = msoTrue
   pic4.Width = pic_default_width_pt

End Sub

Thanks! =D

1

There are 1 answers

2
Steve Rindsberg On BEST ANSWER

Instead of setting a reference to the textbox's .TextFrame.TextRange, set it to the new shape itself, then

With tbox1.TextFrame.TextRange
  .Text = "hello"
  .Font.Bold = True
End With
With tbox1.Fill
  .Visible = True
  .ForeColor.RGB = RGB(255,255,255)
end with
With tbox1.Line
  .Visible = True
  .ForeColor.RGB = RGB(0,0,0)
  .Weight = 2
End With