Exporting shape and sub-shape texts to Excel

Started by cdfjdk, May 24, 2023, 03:08:41 PM

Previous topic - Next topic

0 Members and 1 Guest are viewing this topic.

cdfjdk

I have been trying with only very minor success for over a day now to ungroup all shapes and subshapes so that I can export their Text. These text box texts can be exported by selecting Display Text in the Shape Report generator, so it would seem straightforward.

I have made numerous different attempts, the following being the best so far

Dim vsDoc, vsPage As Object
Dim vsGroup As Visio.Shape   
Dim vsSelection As Visio.Selection

For Each vsPage In vsDoc.Pages

Set vsSelection = vsPage.CreateSelection(visSelTypeAll)
Set vsGroup = vsSelection.Group
vsGroup.Ungroup

Next vsPage


but this only ungroups the first shape in the first page. I can then get the Text from that subgroup, so the Text export part of my macro works. But how do I expand this to ungroup all subgroups in all pages?

After the Text is exported the Visio file is closed without saving, so any disruption to the shapes is not an issue.

The complete macro is here: https://stackoverflow.com/questions/76314570/macro-to-export-visio-text-box-texts-to-excel

PS I am new to Visio VBA!

wapperdude

#1
Some questions...
>>  Are you calling this from Excel
>>  Is this part of a larger macro?

Comment:  Ungrouping shapes can be DISASTEROUS!!!  Don't do it.  Period.  It is not necessary.  To get text from group child members, and if those are groups, from their children, etc. etc.   The technique is recursive selection.  Here is adapted recursive code which excludes 1-D shapes from the output.  Also, the code does not find Field Inserted text.

Test file included.


Sub Main()
' Code provided by Surrogate, adapted by Wapperdude
    ShapesList ActivePage.Shapes
End Sub

Sub ShapesList(ByVal shps As Shapes)
    Dim sh As Shape
    For Each sh In shps
        If sh.Shapes.Count = 0 Then
            If Not sh.OneD Then       'Inside this "IF", place "listing functional code"
                Debug.Print sh.ID, sh.Name, sh.Text
            End If
        End If
        ShapesList sh.Shapes
    Next sh
End Sub
Visio 2019 Pro

wapperdude

Simple code modification finds "normal" text and field inserted text:


Sub Main()
' Code provided by Surrogate
    ShapesList ActivePage.Shapes
End Sub

Sub ShapesList(ByVal shps As Shapes)
    Dim sh As Shape
    Dim vChars As Visio.Characters
   
    For Each sh In shps
        If sh.Shapes.Count = 0 Then
            If Not sh.OneD Then
                Set vChars = sh.Characters
                Debug.Print sh.ID, sh.Name, vChars
            End If
        End If
        ShapesList sh.Shapes
    Next sh
End Sub
Visio 2019 Pro

Paul Herber

Quote from: wapperdude on May 24, 2023, 05:30:29 PM
Ungrouping shapes can be DISASTEROUS!!!  Don't do it.

Wot he said!!! +100
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

wapperdude

Decided to look at your code.  Was this something that you generated?  Basically, it doesn't do anything.  First, it selects everything on 1st page.  Next, it creates a group for everything selected, and then, ungroups it.  Never gets to next page.

The issues with this code
  >> the selectall will never accomplish what you want it to.  It will not select any child shapes; kjust top level single shapes and group parent shapes.
  >> the group line should be deleted
  >> the ungroup could be changed to vsSelection.ungroup.  That does work.  But if there are additional groups, it needs to iterate again...and again until all groups are dissolved.  The For ... Next loop doesn't accommodate this.  It needs to be recursive.
Visio 2019 Pro

Surrogate

Quote from: cdfjdk on May 24, 2023, 03:08:41 PMThe complete macro is here: https://stackoverflow.com/questions/76314570/macro-to-export-visio-text-box-texts-to-excel
I recommend that you add a link to this branch to your original post on the StackOverflow.

This may be useful to other users in the future years later

Yacine

#6
Ungrouping every shape on a page - with or without condition - may be a legit task by its own, but doing it for getting the texts is certainly a very bad idea.
I happen to have written a collection of selection methods on github just a couple of days ago. You'll find there a way to iterate over every shape on a page, including the ones nested in arbitrary levels of grouping.
https://github.com/Visio-Resources/Snippets-n-Libraries/blob/main/VBA%20Handle%20on%20shapes.md
Yacine

hidden layer

Quote from: wapperdude on May 24, 2023, 05:30:29 PM
Ungrouping shapes can be DISASTEROUS!!! 

aah - it depends.
I often import schematics out of KiCAD. There are lots of "shapes" that are graphical expressions of some texts and there are (sometimes) on seperate layers. This is almost 60% of the whole import.
And all of them are grouped - often in further sub-groups.
But the goups doesn't have any functionality on its own.
That's why I can iteate the ungrouping command (with vba) as long there is no group existent anymore.
And after that deleting the unnecessary shapes.

In case of a Visio-shape (what is often a group with its own functionality (!)) you'll destroy this very one. That's the point.

;)

cdfjdk

Many thanks for your help and my apologies for my amateur code. I have updated my code in Stackflow and added a link to this page and credited you with the solution. Please permit one further question - my updated code (also below) loops OK and populates a new XL sheet OK, but the exported data is identical in each sheet - i.e. For each page is not working correctly.

In answer to other comments - while I have worked with VBA I have never worked with Visio VBA before and had read that CreateSelection(visSelTypeAll) would select all groups AND subgroups, enabling me to ungroup them ALL (and avoid the need for recursion) and then export the Shape.Text to Excel, which is my goal. As I would not be saving the Visio file, I did not see any problem with ungrouping everything.

Sub ExportVisioTextsExcel()

    Dim vsPage As Visio.Page
    Dim vsDoc As Visio.Document
    Dim xlApp, xlWB, xlWS, vsApp As Object
    Dim FldPath As String

   
    Set xlApp = CreateObject("Excel.Application")
    Set vsApp = CreateObject("Visio.Application")
    xlApp.Visible = True
    Set xlWB = xlApp.Workbooks.Add
    Set vsDoc = vsApp.Documents.Open("C:\xyz\File.vsdx")
    FldPath = "C:\xyz\"

    For Each vsPage In vsDoc.Pages
        Set xlWS = xlWB.Sheets.Add(After:=xlWB.Worksheets(xlWB.Worksheets.Count))
        ShapesList ActivePage.Shapes, xlWS
    Next vsPage
   
    xlWB.SaveAs FldPath & "xxx" & Format(Now(), "YYYYMMDD")
   
    MsgBox "Texts exported", vbInformation
   
End Sub

Sub ShapesList(ByVal shps As Shapes, ByVal xlWS As Object)
    Dim sh As Shape
    Dim vChars As Visio.Characters
    Dim lRow As Long
    lRow = xlWS.Cells(xlWS.Rows.Count, 1).End(xlUp).Row
   
    For Each sh In shps
        If sh.Shapes.Count = 0 Then
            If Not sh.OneD Then
                Set vChars = sh.Characters
                xlWS.Cells(lRow, 1).Value = sh.ID
                xlWS.Cells(lRow, 2).Value = sh.Name
                xlWS.Cells(lRow, 3).Value = vChars.Text
            lRow = lRow + 1
            End If
        End If
        ShapesList sh.Shapes, xlWS
    Next sh
End Sub


Again many thanks!

Paul Herber

For a start:
Change;

For Each vsPage In vsDoc.Pages
        Set xlWS = xlWB.Sheets.Add(After:=xlWB.Worksheets(xlWB.Worksheets.Count))
        ShapesList ActivePage.Shapes, xlWS
    Next vsPage


to:

For Each vsPage In vsDoc.Pages
        Set xlWS = xlWB.Sheets.Add(After:=xlWB.Worksheets(xlWB.Worksheets.Count))
        ShapesList vsPage.Shapes, xlWS
    Next vsPage


and second, please stop thinking in terms of ungrouping.
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/

wapperdude

#10
Not sure where this came from,
Quoteread that CreateSelection(visSelTypeAll) would select all groups AND subgroups
.  But that is incorrect and sent you down the path to the dark side.  I did try to execute the code to select/group/ungroup.  It does NOT work as anticipated.

Here are links to the official descriptions:

https://learn.microsoft.com/en-us/office/vba/api/Visio.Page.CreateSelection
https://learn.microsoft.com/en-us/office/vba/api/Visio.visselectiontypes

Ocassionally, the web has misinformation.   :o :o :o

Regarding the grouping/ungrouping method.  There is one other concern not previously mentioned.  Ungrouping could lead to an excessive number of shapes on the page.  The hunt for text would have to examine each shape to see if there was text associated with it.  That would be a huge speed impact...in theory.
Visio 2019 Pro

cdfjdk

Thank you both so much!
ShapesList vsPage.Shapes, xlWS seems to have fixed it and I will do a thorough check of the output tomorrow and confirm - if as expected it's a fix maybe you would prefer to post the solution on Stackflow and get the rigthful kudos?
I have wondered about why the ungrouping would be so bad (I promise never to use the word again on this forum!), but "Ungrouping could lead to an excessive number of shapes on the page" explains that.
MANY thanks!

cdfjdk

Again all - many thanks, problem solved! I have changed the title of this thread to reflect it's real purpose and avoid the ungrouping issue.

hidden layer

Quote from: cdfjdk on May 25, 2023, 07:39:41 PM
"Ungrouping could lead to an excessive number of shapes on the page" explains that.

That's not the point (imho).
Because all shapes (grouped or ungrouped) are already there and grab their memory space.
The thing is the functionality of the group within its shapesheet.
Some shapesheet's (or code's) function influence a shape to do s'thing. In case of a group the function is present in the group only. Ungrouping destroys this functionality - relation to its sub-shapes as well to other shapes that only the group was interacting with.

Paul Herber

Whether the shapes are in groups or not is probably of no consequence to Visio. But, a shape within a group could have a text field that refers to the group shape or to another shape within the group. If the shape gets ungrouped then that text is gone.
Some people might say that Microsoft have a reputation for creating buggy code and security holes. Ungrouping shapes to get the text is right up there in that category.
Electronic and Electrical engineering, business and software stencils for Visio -

https://www.paulherber.co.uk/