Shapes Information

Export Shapes information in powerpoint to notepad. Shapes Information includes : Slide Number, Shape Name, Shape Type, Left, Top, Width, Height

Sub ExportCoords()

Dim oSlides As Slides
Dim oSl As Slide
Dim oSh As Shape
Dim strOutput As String
Dim strFileName As String
Dim intFileNum As Integer
Dim lngReturn As Long

' Get a filename to store the collected text
strFileName = InputBox("Enter the full path and name of file to save info to", "Output file?")

' did user cancel?
If strFileName = "" Then
Exit Sub
End If

' is the path valid? crude but effective test: try to create the file.
intFileNum = FreeFile()
On Error Resume Next
Open strFileName For Output As intFileNum
If Err.Number <> 0 Then ' we have a problem
MsgBox "Couldn't create the file: " & strFileName & vbCrLf _
& "Please try again."
Exit Sub
End If
Close #intFileNum ' temporarily

strOutput = "Slide" & vbTab & "Name" & vbTab & "Type" _
& vbTab & "Left" & vbTab & "Top" & vbTab & "width" _
& vbTab & "height" & vbCrLf

' Get the info
Set oSlides = ActivePresentation.Slides
For Each oSl In oSlides
For Each oSh In oSl.Shapes
strOutput = strOutput _
& oSl.SlideIndex & vbTab _
& oSh.Name & vbTab _
& oSh.Type & vbTab _
& oSh.Left & vbTab _
& oSh.Top & vbTab _
& oSh.Width & vbTab _
& oSh.Height & vbCrLf
Next oSh
Next oSl

' now write the text to file
Open strFileName For Output As intFileNum
Print #intFileNum, strOutput
Close #intFileNum

' show what we've done
lngReturn = Shell("NOTEPAD.EXE " & strFileName, vbNormalFocus)

End Sub