Parsing text from Smartart shapes.

[Kev from Austin]

Hi everyone,

I am trying to build a mechanism to scan a PPT and store all the related
textual information into a database. I have the VBA code to get test from
normal text shapes, but I would like to find a code sample to also extract
the text from smart art shapes. I see references that smartart shapes can be
treated like a group object but would love to see the code for such.

Any pointers on this matter would be great.

Cheers,
Kev

 

[John Wilson]

Assuming oshp is a reference to the smart art

try

If oshp.Type = msoSmartArt Then
For i = 1 To oshp.GroupItems.Count
Debug.Print oshp.GroupItems(i).TextFrame.TextRange
Next i
End If

Note the text is read only

 

[David Marcovitz]

Hi everyone,

I am trying to build a mechanism to scan a PPT and store all the related
textual information into a database. I have the VBA code to get test from
normal text shapes, but I would like to find a code sample to also extract
the text from smart art shapes. I see references that smartart shapes can be
treated like a group object but would love to see the code for such.

Any pointers on this matter would be great.

Cheers,
Kev

I am able to see the text of a SmartArt shape with something like this:

ActivePresentation.Slides(1).Shapes(3).GroupItems(1) _
.TextFrame.TextRange.Text

That assumes that my SmartArt is shape #3 on slide #1. You should be able to
cycle through each of the group items (this just gets you the text of the
first shape) to extract all the text.

--David
--
David M. Marcovitz
Author of _Powerful PowerPoint for Educators_
http://www.PowerfulPowerPoint.com/
Microsoft PowerPoint MVP
Associate Professor, Loyola University Maryland

 

[John Wilson]

Doh

Check for textframe- definitely a good idea!!
--
john ATSIGN PPTAlchemy.co.uk
Custom vba coding and PPT Makeovers
Free PPT Hints, Tips and Tutorials
http://www.pptalchemy.co.uk/powerpoint_hints_and_tips_tutorials.html

 

[Kev from Austin]

Thanks this was very helpful

This works with the currently selected shape; modify as needed for other
porpoises for that true endolphin rush:

Sub SmartArtText()

Dim oSh As Shape
Dim oSubShape As Shape
Dim x As Long
Set oSh = ActiveWindow.Selection.ShapeRange(1)
With oSh
If .Type = msoSmartArt Then
For x = 1 To .GroupItems.Count
With .GroupItems(x)
If .HasTextFrame Then
If .TextFrame.HasText Then
Debug.Print .TextFrame.TextRange.Text
End If
End If

End With
Next
End If
End With

End Sub



==============================
PPT Frequently Asked Questions
http://www.pptfaq.com/

PPTools add-ins for PowerPoint
http://www.pptools.com/

 

[David Marcovitz]

Well, that seals it. Steve is our kingfish. He can open any PowerPoint lox.

 

[John Wilson]

Second vote for King Steve ;0)

 

[Shyam Pillai]

Hey Steve,
Using the groupitems and enumerating the smartart shapes works however it
fails in many instances when it comes to text within the shapes. My approach
to extract text has been to ungroup the smart art and reduce it to a regular
shapes collection and then extract the text out of it. This works all the
time.

Sub Example()
Dim oSld as Slide

Set oSld = UngroupSA(ActiveWindow.Selection.ShapeRange(1),
ActiveWindow.Selection.SlideRange(1))
If Not oSld Is Nothing then
'Extract text from shapes on this slide and then delete the
slide.
Endif

End Sub


Function UngroupSA(oSAShp As Object, oSASld As Slide) As Slide
'<EhHeader>
On Error GoTo UngroupSA_Err
'</EhHeader>
Dim oShp As PowerPoint.Shape
Dim oSldCopy As Slide
Dim sShpArray() As Long
Dim I As Long

If oSAShp.Type = msoSmartArt Or _
(oSAShp.Type = msoPlaceholder And _
oSAShp.PlaceholderFormat.ContainedType = msoSmartArt)
Then

Set oSldCopy = oSASld.Duplicate(1)
oSldCopy.Shapes.Range.Delete

If oSldCopy.Shapes.Count > 0 Then oSldCopy.Shapes.Range.Delete

Application.ActiveWindow.View.GotoSlide oSASld.SlideIndex

ReDim sShpArray(1 To oSAShp.GroupItems.Count)

For I = 1 To oSAShp.GroupItems.Count
sShpArray(I) = I
Next I

oSAShp.GroupItems.Range(sShpArray).Select
Application.ActiveWindow.Selection.Copy
Set oShp = oSldCopy.Shapes.Paste(1)

Application.ActiveWindow.Selection.Unselect
Set UngroupSA = oSldCopy
Else
Set UngroupSA = Nothing
End If

Exit Function

UngroupSA_Err:
Call MsgBox(Err.Description & "in UngroupSA " & "at line " & Erl)
Resume Next
'</EhFooter>
End Function


Regards,
Shyam Pillai

Image Importer Wizard: http://skp.mvps.org/iiw.htm

 

[Shyam Pillai]

Have you let them know about the text

problem?

Yes.

Regards,
Shyam Pillai

Animation Carbon: http://www.animationcarbon.com

 

[Kev from Austin]

I have the following code

If oSh.Type = msoSmartArt Then
For x = 1 To oSh.GroupItems.Count
With oSh.GroupItems(x)
If .HasTextFrame Then
If .TextFrame.HasText Then
sTempText = sTempText & .TextFrame.TextRange.Text & vbCrLf
End If
End If
End With
Next
End If

However, the oSh.GroupItems.Count always comes back equal to "0".

Any Ideas?