A Macro to export Information

[novski]

Hi
I have already once asked this question and got a nice answer from jumpy. Its from 2014 so i will start over new but a bit more focused.
As im a noob in programing but like to learn some basic skills in VBA i wold prefer a Macro i can shoot...

I make Audio Video drawings and for this test its a simplyfied connection like a CD Player to a Amplifier by a 1D connector.

First, i wold like to test how to count the shapes on one Page that have a shapedatafield called "export".
Second, how to count the shapes on all Pages with the same shapedatafield called "export".

Maybe somebody can help me create that...? or point me to a source that is as basic and tutorial like as possible...? 

[novski]

I found something to start from MVPs 

http://visio.mvps.org/vba/ way down...

Code Select Expand

Shape - List group members: This is a piece of sample code that loops through the shapes in a group and displays the names. It uses recursion to handle shape collections within shapes.
from John Marshall - Visio MVP

Public Sub ListGroup()
Dim vsoSelect As Visio.Selection
Dim vsoShape As Visio.Shape
Dim vsoShapes As Visio.Shapes

Set vsoSelect = Visio.ActiveWindow.Selection

If vsoSelect.Count > 0 Then
For Each vsoShape In vsoSelect
Call ProcessShape([b]shp[/b])
Next vsoShape
Else
MsgBox "You Must Have Something Selected"
End If

End Sub

Public Sub ProcessShape(shp As Visio.Shape)
Dim subshp As Visio.Shape

Debug.Print shp.Name

If shp.Shapes.Count > 0 Then
For Each subshp In shp.Shapes
Call ProcessShape(subshp)
Next subshp
End If

End Sub

MsgBox "You Must Have Something Selected"
end if

there seams to be someting not working with shp
As it spits out a error ByRef "unverträglich" -GER for incompatible...
Why?

Im on Visio 2013

[Yacine]

Hi Novski,
you're close!
Just one minor adjustment:

Loop 1: just fine
Loop 2:
Public Sub ProcessShape(shp As Visio.Shape)
Dim subshp As Visio.Shape

' Process "shp" here:
' code code code

'process its children:
If shp.Shapes.Count > 0 Then
For Each subshp In shp.Shapes
   'check condition
   if this and that then ...
         ' no need for "Call" Call ProcessShape(subshp)
          ProcessShape subShp (no brackets!)
   end if
Next subShp
End If

End Sub

This should do it.
Regards,
Y.

Why a German version? I thought you were more on the slavic side?

[novski]

Thank you Yacine
I was able to fix a few different issues that came up but now im lost:
"Runtime error 91: Object variable or with block variable not set"

This is the code part that gets highlighted: Debug.Print shp.Name

And this the full codesnipet:

Code Select Expand

Public Sub ListGroup()
Dim vsoSelect As Visio.Selection
Dim vsoShape As Visio.Shape
Dim vsoShapes As Visio.Shapes
Dim shp As Visio.Shapes

Set vsoSelect = Visio.ActiveWindow.Selection

If vsoSelect.Count > 0 Then
For Each vsoShape In vsoSelect
    Call ProcessShape(shp)
Next vsoShape
Else
MsgBox "You Must Have Something Selected"
End If

End Sub

Public Sub ProcessShape(shp As Visio.Shape)
Dim subshp As Visio.Shape

Debug.Print shp.Name

If shp.Shapes.Count > 0 Then
For Each subshp In shp.Shapes
    ProcessShape subshp
Next subshp
End If
End Sub

My name is related to a comon Russian name and some friends started to call me as joke "Novski" allthrough im Swiss and not slavic...
Novski stayed somehow and i use it as a nick...  So i speak native Swissgerman... Maybe someday MS translates Visio to swissgerman... 
Regards, Novski

[Yacine]

Wer hats erfunden?

[wapperdude]

Unless I'm not following the code correctly, it looks like the sub "ProcessShp" only prints subshp name, and then calls itself.  This repeats over  and over until the loop runs out  of subshapes, and then generates an error.

Not the best approach for making a loop, as it is guaranteed to create an error.  There should  plenty of code examples on how to loop thru all subshapes  of a group.  For example, loop thru all the shapes on a page, check is there are move than one shape associated with it, then loop thru subshapes until total number have been checked.

Code Select Expand

Sub NameSubShps()
'
'  This sample code searches thru all shapes on a page and gives their names, including shapes belonging to a group.
'  This probably a good candidate for a recursive code, as the group subshapes may have subshapes, etc,  and this code is too simple for those cases.
'
    Dim vsoShps As Visio.Shapes
    Dim vsoShp As Visio.Shape
    Dim i As Integer
    Dim shpCnt As Integer
   
    Set vsoShps = ActiveWindow.Page.Shapes
    For Each vsoShp In vsoShps
        shpCnt = vsoShp.Shapes.Count
        If shpCnt > 1 Then
            For i = 1 To shpCnt
                Debug.Print vsoShp.Shapes(i).Name
            Next i
        Else
            Debug.Print vsoShp.Name & " has no subshapes."
        End If
    Next

End Sub

Where the debug. Print statements are, that's where  the  call shpProcess could go.

Then, the actual subroutine , shpProcess, would have only the code to do the actual processing.  But, it should not call itself.


Wapperdude