Search code examples
vbasortingtextboxpowerpoint

VBA - Powerpoint Sort Textboxes base on their “Top” and “Left” property


i have a bunch of textboxes in a powerpoint slide. They all contain text.

I need to sort those textboxes in order, so i can loop through those textboxes, capture the text, and export it to a CSV file, IN ORDER, from top-left to bottom-right.

For example, if i have 4 textboxes in a slide, i need to capture text in the textbox, in the order of

  1. TOP-LEFT textbox
  2. TOP-RIGHT textbox
  3. BOTTOM-LEFT textbox
  4. BOTTOM-RIGHT textbox

The part of the code (i got from internet) that exports the textbox's text to a CSV file works. Except that they are out of order.

Sub ExportTextToCSV()

    Dim oPres As Presentation
    Dim oSlides As Slides
    Dim oSld As Slide         'Slide Object
    Dim oShp As Shape         'Shape Object
    Dim sTempString As String
    Dim Quote As String
    Dim Comma As String
    Dim myText As String
    Dim myFilePath As String

    myFilePath = ".\Export_Textbox.CSV"
    Quote = Chr$(34)
    Comma = ","

    Set oPres = ActivePresentation
    Set oSlides = oPres.Slides

    For Each oSld In oSlides  'Loop thru each slide
      For Each oShp In oSld.Shapes   'Loop thru each shape on slide

        'Check to see if shape has a text frame and text
        If oShp.HasTextFrame And oShp.TextFrame.HasText Then
            myText = Replace(oShp.TextFrame.TextRange.Text, vbCr, vbCrLf)
            sTempString = sTempString & Quote & myText & Quote & Comma
        End If

      Next oShp

      'Add new line in CSV
      sTempString = sTempString & vbCrLf

      'Print the result to file:
      Call WriteToTextFileADO(myFilePath, sTempString, "UTF-8")

      'Clear the string
      sTempString = ""

    Next oSld
End Sub

Sub WriteToTextFileADO(filePath As String, strContent As String, CharSet As String)
    Set stm = CreateObject("ADODB.Stream")

    'if file exist, append
    If Len(Dir(filePath)) > 0 Then
        stm.Type = 2
        stm.Mode = 3
        stm.Open
        stm.CharSet = CharSet
        stm.LoadFromFile filePath
        stm.Position = stm.Size
        stm.WriteText strContent
        stm.SaveToFile filePath, 2
        stm.Close
    Else
        stm.Type = 2
        stm.Mode = 3
        stm.Open
        stm.CharSet = CharSet
        stm.WriteText strContent
        stm.SaveToFile filePath, 2
        stm.Close
    End If

    Set stm = Nothing
End Sub

According to stackoverflow's post "VBA For each - loop order", it says:

"A shape's position in the z-order corresponds to the shape's index number in the Shapes collection."

I'm thinking of first creating and running a macro to re-set all the shapes z-order, base on "Top" and "Left" property of the textbox shape, before i run the ExportTextToCSV() macro.

I'm having trouble on using ShapeRange or Collection, to add reference to EXISTING SHAPES in a slide, and on sorting them base on their "Top" and "Left" property.

Please help. Thanks!


Solution

  • Create a disconnected recordset using ADO, populate it with textbox name, text, top and left properties, then sort it by top then left position. Use that to populate your text file. See for example: developer.rhino3d.com/guides/rhinoscript/… – Tim Williams 23 hours ago

    It worked. Thanks for pointing me in the right direction!

    If you don't mind, please re-post your comment as an answer, so i can mark it as an answer.