advanced code snippet search

Posted By

kaze on 08/16/11


Tagged

powerpoint vba


Versions (?)

Powerpoint - Split Text

 / Published in: Visual Basic
 

What It Does Extracts the words out of a selected text shape in Powerpoint, and then creates separate shapes for them.

To use:

  1. Create your Text shape. Type your text. Format it, color it, etc.
  2. Select the text shape.
  3. Run macro.
Expand | Embed | Plain Text 
  1. Sub SplitText()
  2.  
  3. Dim sentence() As String
  4.  
  5. Set mydoc = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.Name)
  6. curshape = ActiveWindow.Selection.ShapeRange.Name
  7. twords = Split(ActiveWindow.Selection.TextRange.Text, " ")
  8. c = mydoc.Shapes.Count
  9. xpos = mydoc.Shapes(curshape).Left
  10. ypos = mydoc.Shapes(curshape).Top + mydoc.Shapes(curshape).Height + 10
  11.  
  12. ReDim sentence(0 To UBound(twords))
  13. For i = 0 To UBound(twords)
  14.     Set newtxt = mydoc.Shapes.AddTextbox(msoShapeRectangle, xpos, ypos, Len(twords(i)), 1)
  15.     mydoc.Shapes(curshape).PickUp
  16.     With newtxt
  17.         .Apply
  18.         .Name = "Word_" & c & "-" & (i + 1)
  19.         With .TextFrame
  20.             .AutoSize = ppAutoSizeShapeToFitText
  21.             .WordWrap = msoFalse
  22.             .TextRange.Text = twords(i) & " "
  23.             .MarginLeft = 0
  24.             .MarginRight = 0
  25.             .TextRange.ParagraphFormat.Bullet.Visible = False
  26.         End With
  27.     End With
  28.  
  29.     'if text goes out of bounds, move to next line & flush left
  30.     If (newtxt.Left + newtxt.Width >= ActivePresentation.SlideMaster.Width) Then
  31.         ypos = newtxt.Top + newtxt.Height
  32.         xpos = mydoc.Shapes(curshape).Left
  33.         With newtxt
  34.             .Top = ypos
  35.             .Left = xpos
  36.         End With
  37.     End If
  38.  
  39.     'computes for xpos for next shape
  40.     xpos = newtxt.Left + newtxt.Width
  41.  
  42.     'adds to array; for grouping
  43.     sentence(i) = newtxt.Name
  44.  
  45. Next
  46.  
  47. mydoc.Shapes.Range(sentence).Group
  48.  
  49. End Sub

Report this snippet  

You need to login to post a comment.