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