Automatic numbering on dropevent

[Paul Herber]

Is your macro name the same as in your shape? Is the macro called? Add a debug statement or two.

[frankp]

I've tried it with a simple code:

Code Select Expand


Public Sub Hello()

      MsgBox ("Hello World")

End Sub

and added the "=CALLTHIS("Hello","Test")" in the EventDrop cell.
But the macro isn't called on dropping the shape.

When i manually run the macro it works fine.

[Jumpy]

A macro for CALLTHIS needs a variable for reference to calling shape:

Code Select Expand


Public Sub Hello(shp As Visio.Shape)

      MsgBox ("Hello World from " & shp.Name)

End Sub


[Jumpy]

And in your original MyMacro code, the line

  If Not NeedsCounting(shpAdded) Then Exit Sub

must be

  If Not NeedsCounting(shp) Then Exit Sub

shpAdded seems to be a relic from your previous efforts...

[frankp]

Hi Jumpy,

the "Hello World" part is working, but the original code isn't.

The code looks like this

Code Select Expand


Function NeedsCounting(ByVal shp As IVShape) As Boolean

    NeedsCounting = False
   
    If shp.Master Is Nothing Then Exit Function
    If Left(shp.Master.Name, Len("Master.0")) <> "Master.0" Then Exit Function

   
    NeedsCounting = True

End Function

Public Sub MyMacro(shp As Visio.Shape)

    If Not NeedsCounting(shp) Then Exit Sub
   
    Set allShapes = ActivePage.Shapes
   
    Count = 0
    For I = 1 To allShapes.Count
        If NeedsCounting(allShapes(I)) Then
            Count = Count + 1
        End If
    Next
   
    shpAdded.Text = Count & "/" & Count
   
    For I = 1 To allShapes.Count - 1
        If NeedsCounting(allShapes(I)) Then
            allShapes(I).Text = I & "/" & Count
        End If
    Next

End Sub

With "=CALLTHIS("ThisDocument.MyMacro"."Test")" in the eventdrop cell.

[Jumpy]

I would set some stop points in the Code and go through it step by step to see where the problem lies.
Or place some messageboxes to see how far you come:

Code Select Expand


Function NeedsCounting(ByVal shp As IVShape) As Boolean
    msgbox 2
    NeedsCounting = False
   
    If shp.Master Is Nothing Then Exit Function
    msgbox 3 & shp.Master.Name
    msgbox 4 & Left(shp.Master.Name, Len("Master.0"))
    If Left(shp.Master.Name, Len("Master.0")) <> "Master.0" Then Exit Function

    msgbox 5
    NeedsCounting = True

End Function

Public Sub MyMacro(shp As Visio.Shape)
    msgbox 1
    If Not NeedsCounting(shp) Then Exit Sub
    msgbox 6


[frankp]

It stops after msgbox 4, with the message in box 4 "Master.3"

[Jumpy]

OK, then there's the problem.
The name of the master is not "Master.0" but "Master.3"

I don't remember the naming conventions in Visio. Is the shapes master the master in the stencil, or is it the copy of the master in the document stencil, so the number could be different in different drawings?
May be easier to use another name for the master, that only you use eg. "MyTestmaster" and to ignore the number:

if Left(shp.Master.Name, Len("MyTestmaster")) <> "MyTestmaster" then Exit function

[aledlund]

part of the reason that this didn't work
"
Public Sub Hello(shp As Visio.Shape)

      MsgBox ("Hello World from " & shp.Name)

End Sub"
is that "=CALLTHIS("Hello","Test")" has an operand included  ("test") which your sub module did not allow room for.

Regarding the shape name, the name is based on the 'master' name and the number tells you which copy of the master has been placed on the page. With that you can deduce that Len("master.0") is going to fail as soon as you have greater than 10 copies on the page. It's documented over here

http://msdn.microsoft.com/en-us/library/office/aa245244(v=office.10).aspx


al

[frankp]

With the shapename MyTestmaster it runs through the code but after msgbox 6 it runs back to msgbox 2, then proceeds to msgbox 5 and there the code ends again.
Msgbox 3 returns MyTestmaster.38 (or higher).

It seems it's that the problem lies with the number the shapename get's as Al said.
Any sollution for this? (it's going beyond my knowledge and understanding of VBA now)

[Jumpy]

Why don't you ignore the number?

If  "MyTestmaster" is part of the name of the master, the shape gets counted, otherwise not.

Or maybe you could post the complete code and what it should do, or upload an example drawing.

[AndyW]

As I said in an earlier if you use,

shp.MasterShape.Name

Then it will always give the name "Master"

No messing with a number.

[frankp]

Oke, here's the code with the msgboxes stil in the code for testing.

What is want is the following:
I want a *.vss file with a shape which can be used in any drawing which automatically numbers the specified shape.
Example:
shape number one get's 1/1
adding a second shape changes the first to 1/2 and the second to 2/2.

Code Select Expand


Function NeedsCounting(ByVal shp As IVShape) As Boolean
    MsgBox 2
    NeedsCounting = False
   
    If shp.Master Is Nothing Then Exit Function
    MsgBox 3 & shp.Master.Name
    MsgBox 4 & Left(shp.Master.Name, Len("MyTestmaster"))
    If Left(shp.Master.Name, Len("MyTestmaster")) <> "MyTestmaster" Then Exit Function

    MsgBox 5
    NeedsCounting = True

End Function

Public Sub MyMacro(shp As Visio.Shape)
    MsgBox 1
    If Not NeedsCounting(shp) Then Exit Sub
    MsgBox 6

   
    Set allShapes = ActivePage.Shapes
   
    Count = 0
    For I = 1 To allShapes.Count
        If NeedsCounting(allShapes(I)) Then
            Count = Count + 1
        End If
    Next
   
    shpAdded.Text = Count & "/" & Count
   
    For I = 1 To allShapes.Count - 1
        If NeedsCounting(allShapes(I)) Then
            allShapes(I).Text = I & "/" & Count
        End If
    Next

End Sub


[Yacine]

It was just an inadvertence from you. You should have written:

Code Select Expand


Function NeedsCounting(ByVal shp As IVShape) As Boolean
'    MsgBox 2
'    NeedsCounting = False
'
'    If shp.Master Is Nothing Then Exit Function
'    MsgBox 3 & shp.Master.Name
'    MsgBox 4 & Left(shp.Master.Name, Len("MyTestmaster"))
'    If Left(shp.Master.Name, Len("MyTestmaster")) <> "MyTestmaster" Then Exit Function
'
'    MsgBox 5
    NeedsCounting = True

End Function

Public Sub MyMacro(shp As Visio.Shape)
'    MsgBox 1
    If Not NeedsCounting(shp) Then Exit Sub
'    MsgBox 6

   
    Set allShapes = ActivePage.Shapes
   
    Count = 0
    For i = 1 To allShapes.Count
        If NeedsCounting(allShapes(i)) Then
            Count = Count + 1
        End If
    Next
   
   shp.Text = Count & "/" & Count

   
    For i = 1 To allShapes.Count - 1
        If NeedsCounting(allShapes(i)) Then
            allShapes(i).Text = i & "/" & Count
        End If
    Next
   

End Sub


[frankp]

Omg, now I see the i 

Hero Yacine.
Thx!

It's working perfectly now.