marcvanderpeet12
Member
Dear all,
I have a powerpoint with a shape on it. I already wrote code in powerpoint VBA so it prints out all the "editable" points of the shape. You can reproduce that by copying the figure from the excel sheet into a powerpoint and run the following code (cant upload ppt files)
If you run in the ppt you will see that it prints out the coordinates.
However I want the coordinates to be stored in an excel file. So therefore I copied the figure to an excel and want to do the same exercise as above but then store the coordinates in excel (in stead of popping up).
Does anybody have advice on how to do this?
I have a powerpoint with a shape on it. I already wrote code in powerpoint VBA so it prints out all the "editable" points of the shape. You can reproduce that by copying the figure from the excel sheet into a powerpoint and run the following code (cant upload ppt files)
Code:
Sub test()
Dim oSlides As Slides 'all slides
Dim oSl As Slide 'slide
Dim oSh As Shape 'shape
Dim strOutput As String 'result output
Dim strFileName As String 'output .txt file name
Dim intFileNum As Integer
Dim n As ShapeNode 'node of shape
Dim x, y As Single 'coordinates of node
Dim stringcount As String 'use to create each shape in a different string number in Surpac
Dim curFolder As String
Dim correctY As String
'The coordinate system of Powerpoint start at the upper left corner
' going downward for the vertical. The Y value as to be corrected
' Get the info
Set oSlides = ActivePresentation.Slides
For Each oSl In oSlides 'for each slide in the presentation
'create a data header for the data extracted
strOutput = "Slide" & ", " & "stringcount" & ", " & "x" & ", " _
& "y" & ", " & "z" & ", " & "curved=1" & ", " & ", " & "Name" & vbCrLf
'set the Surpac string number
stringcount = 1
For Each oSh In oSl.Shapes 'for each shape in the slide
If oSh.Type = msoFreeform Then
For Each n In oSh.Nodes 'for each node of each shape
'correctY = 1000 - n.Points(1, 2) 'correct Y value of nodes to have Y axis upward
'create the output as a comma-delimited file style
'slide #, string #, Y, X, default Z=0, freeform #
strOutput = strOutput _
& oSl.SlideIndex & ", " _
& stringcount & ", " _
& n.Points(1, 1) & ", " _
& n.Points(1, 2) & ", " _
& "0" & ", " _
& n.SegmentType & ", " _
& oSh.Name & vbCrLf
MsgBox (strOutput)
Next n
stringcount = stringcount + 1
End If
Next oSh
' Create a .txt file for each slide that will be saved in the
' same directory than this presentation
strFileName = "Slide_num_" & oSl.SlideIndex & ".txt"
intFileNum = FreeFile()
Open strFileName For Output As intFileNum
If Err.Number <> 0 Then ' message if problem creating file
MsgBox "Couldn't create the file: " & strFileName & vbCrLf _
& "Please try again."
Exit Sub
End If
Print #intFileNum, strOutput
Close #intFileNum
Next oSl
End Sub
Sub test2()
Set myDocument = ActivePresentation.Slides(1)
With myDocument.Shapes.AddLine(BeginX:=328.8083, BeginY:=166.5793, EndX:=328.1013, EndY:=168.7332).Line
.DashStyle = msoLineDashDotDot
.ForeColor.RGB = RGB(50, 0, 128)
End With
End SubIf you run in the ppt you will see that it prints out the coordinates.
However I want the coordinates to be stored in an excel file. So therefore I copied the figure to an excel and want to do the same exercise as above but then store the coordinates in excel (in stead of popping up).
Does anybody have advice on how to do this?
Last edited:
