TPE
Tavvafi@gmail.com |
≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡≡
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