Exporting shapes information (colour, fill pattern, text) to Excel

[verifiablycurious]

Could you help me export information about shapes on a page to Excel? I'm looking for the text, fill colour and pattern of a shape, ideally, along with the container name.

I've inherited a Visio file that has hundreds of shapes each with a certain colour/fill for certain meanings, e.g. Green fill is good, cross-hatched green is partial. I exported using the Report option which worked for exporting the text, but it didn't seem to have the fill colour.

When I look at the shape sheet, the shape master type is "Process". For each of the colours, though, the FillForegnd =THEMEGUARD(THEMEVAL("AccentColor2")).

I looked on the Microsoft documentation site (like https://docs.microsoft.com/en-us/office/vba/api/visio.colors.item) but when I tried to walk through this example in Debug mode to see the shape's properties but I couldn't find the "color" property.

Sub FillSquareRed()
  Dim shp As Visio.Shape
  Dim i As Integer
  Dim txtBox As String
  ActiveWindow.DeselectAll
  For i = ActivePage.Shapes.Count To 1 Step -1
     Set shp = ActivePage.Shapes.ItemU(i)
       If Not (shp.Master Is Nothing) Then
           If shp.Master.Name = "Process" Then
(...)


Thank you!

[Surrogate]

recently we have same thread there.

You can get RGB value for some theme

Code Select Expand

Sub verifiablycurious()
Dim shp As Shape
Set shp = ActiveWindow.Selection.PrimaryItem
Debug.Print shp.Cells("FillForegnd").FormulaU, shp.Cells("FillForegnd").ResultStr("")
'THEMEGUARD(THEMEVAL("AccentColor2"))      RGB(237; 125; 49)
End Sub

[verifiablycurious]

Thank you, Surrogate! That's the first step -- figuring out where the colour and fill values are stored. Now, which variable has what's called the "Display text" in the Report? I've been looking here: https://docs.microsoft.com/en-us/office/client-developer/visio/cells-visio-shapesheet-reference

Then the next step is to see if I can get the displayed text in the container as this has become important (* edit to add line *)
The final step is how to export those three values (colour, fill pattern, display text) to Excel.

Here's the code I used as the ActiveWindow threw an error.

Sub DebugCells()
  Dim shp As Visio.Shape
  Dim i As Integer
  Dim txtRGB As String
  Dim txtFillPattern As String
 
  ActiveWindow.DeselectAll
  For i = ActivePage.Shapes.Count To 1 Step -1
     Set shp = ActivePage.Shapes.ItemU(i)
           If shp.Master.Name = "Process" Then
'
           txtFillGrandient = shp.Cells("FillPattern").ResultStr("")
           txtRGB = shp.Cells("FillForegnd").ResultStr("")
       
End If
Next i
End Sub

[Surrogate]

Use code for get Displayed text

Code Select Expand

txt = shp.Text
Usually i get error in ActiveWindow, when i have opened ShapeSheet window. What about at your side?

[verifiablycurious]

Thanks again, Surrogate! Would you know how to get the container's displayed text for each shape inside that container?

For the other error, yes I had the ShapeSheet window open.

[verifiablycurious]

How do I export this special shape information to Excel? I feel like there should be some standard VBA code to do this but I haven't been able to find it. Thanks!

[Surrogate]

How do I export this special shape information to Excel? I feel like there should be some standard VBA code to do this but I haven't been able to find it. Thanks!

you need write code something like this

Code Select Expand

Sub DebugCells()
Dim EA As Object ' LATE BINDING, DEFINE Excel.Application
Dim EW As Object ' LATE BINDING, DEFINE Excel.Workbook
Dim ES As Object ' LATE BINDING, DEFINE Excel.worksheet
Dim r As Integer ' row counter
r = 1
Set EA = CreateObject("excel.application") ' create new Excel app session
EA.Visible = True ' make stis session visible
Set EW = EA.workbooks.Add ' create new workbook in this session
Set ES = EW.sheets(1) ' set first sheet is active
Dim shp As Visio.Shape
Dim i As Integer
Dim txtRGB As String
Dim txtFillPattern As String
Dim txtShape As String
ActiveWindow.DeselectAll
For i = ActivePage.Shapes.Count To 1 Step -1
    Set shp = ActivePage.Shapes.ItemU(i)
    txtFillGrandient = shp.Cells("FillPattern").ResultStr("") ' get shape fill pattern
    txtRGB = shp.Cells("FillForegnd").ResultStr("") ' get shape foreground color
    txtShape = shp.Text ' get shape text
    ES.Cells(r, 1) = shp.Name ' fill cell with current shape name
    ES.Cells(r, 2) = txtShape ' fill cell with current shape text
    ES.Cells(r, 3) = txtFillPattern  ' fill cell with current shape fill pattern
    ES.Cells(r, 4) = txtRGB ' fill cell with current shape foregrount color
    r = r + 1
Next i
EW.SaveAs "c:\forum\test.xlsx" ' save Workbook
End Sub

Would you know how to get the container's displayed text for each shape inside that container?

you need add recursion for these shapes

Code Select Expand

Sub a()
    Dim sh As Visio.Shape
    Dim pg As Visio.Page
    Dim coll As New Collection

    For Each pg In ThisDocument.Pages
        For Each sh In pg.Shapes
            If sh.Shapes.Count > 0 Then
                Recursion sh.Shapes, coll
            End If
            coll.Add sh
        Next sh
    Next pg
    For Each sh In coll
        sh.CellsSRC(visSectionObject, visRowMisc, visNonPrinting).FormulaForceU = "False"
    Next sh
End Sub
Sub Recursion(ByVal shps As Visio.Shapes, coll As Collection)
    Dim sh As Visio.Shape
    For Each sh In shps
        If sh.Shapes.Count > 0 Then
            Recursion sh.Shapes, coll 'çäåñü ïðîèñõîäèò âûçîâ ñàìîé ñåáÿ
        End If
        coll.Add sh
    Next sh
End Sub

Thanks to 9rey for recursion macro

PS

Would you know how to get the container's displayed text for each shape inside that container?

Hope this thread can helps: VBA - select all shapes in container

[verifiablycurious]

Thank you so much, Surrogate! The recursion code was helpful in ordering the text. I couldn't figure out how to extract the correct container name. There often two containers and sometimes the processes were not actually in the container on the diagram. I ended up creating another table and doing a match via VLookup. As I was trying different method names to see if I could pull the Container name, I ended up adding in a delimiter between values on the string in Debug.Print and copying the output from the Inspector window and copied and pasted that to Excel.