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:
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
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