ComplexScriptFont Bug ?

[monojohnny]

Hello - I wonder if anybody has seen this before..[actually there appears to be a 'cascade' of problems here]

1. I have a shape which is showing the wrong font as its text (Wingdings).
2. Now I go to : Tools | Options | Regional Setting, and switch on 'Complex scripts text' to 'Show'
3. Right Click the shape, Format | Text - I can see the Complex scripts Font: is indeed set to Wingdings
4. I change the font (just clear the field), and click apply | OK: The shape is correctly updated.

Now...here's the funny business:

1. If I repeat the steps above, but record the steps with a macro (just step 3 actually) I get this: [I have stripped out the undo steps here, the font is being set to Courier as it happens in this instance ]

Sub Macro1()
    Application.ActiveWindow.Page.Shapes.ItemFromID(4).CellsSRC(visSectionCharacter, 0, visCharacterComplexScriptFont).FormulaU = "71"

2. When I run this Macro: the shape DOES NOT GET UPDATED. However, the properties show the Complex scripts font has changed in the field - the shape just hasn't 'noticed' it....

Actually I have instances where the 'complex scripts' is set to blank: but the shape shows with Wingdings (or other crazy) fonts.

In each case, the only sure way of restoring normality is to go through the manual procedure.

I have used this VBA: (It works on some shapes - but not these weird ones...)

---
Sub Show_Complex_Fonts()
Dim shapeObject As Visio.Shape
Dim cellObject As Visio.Cell
Dim Count As Integer

For Count = 1 To ActivePage.Shapes.Count
    Set shapeObject = ActivePage.Shapes(Count)
    Set cellObject = shapeObject.Cells("Char.ComplexScriptFont")
    MsgBox "Shape:" + shapeObject.Text + ", Complex Font=" + cellObject.Formula
Next Count

End Sub
---

This also does the same: weirdly when I run the above, and then query back with:

---
Sub Show_Complex_Fonts()
Dim shapeObject As Visio.Shape
Dim cellObject As Visio.Cell
Dim Count As Integer

For Count = 1 To ActivePage.Shapes.Count
    Set shapeObject = ActivePage.Shapes(Count)
    Set cellObject = shapeObject.Cells("Char.ComplexScriptFont")
    MsgBox "Shape:" + shapeObject.Text + ", Complex Font=" + cellObject.Formula
Next Count

End Sub
---
...the font IS reported back correctly - but the shape doesn't change...

Sorry for long-winded email - anybody seen this, or something like this - or something any part of any of this ?

Cheers !

John

[vojo]

visio does not go by font type....just blindly goes after an offset in the list of fonts and doesnt update until
the shape is altered.

Specifically, when using June the seconds iso stencil and installng the isometric fonts....all works great....then
say 2 weeks later I am browing a web page that has some sort foreign language...explorer updates by inserting that font into the font tree.....meanwhile back at the ranch, 2 weeks later, I decide to open up visio.   It references the font
number used when the shape was alterned a month ago....so it blindly goes after font=64.....but now 64 can be 1 increment above...so instead of the font be iso left...its now, say, guillium.

Long story short, fonts are not treated as thoroughly as shapes/colors/etc in visio.
You may need to test fonts in your macro to make sure it is what you want.

Hope this was helpful (took me a while to figure why my shape fonts would spontaneously change when I edited shape color or moved the shape)

[monojohnny]

Some more information on this : and a follow-up question - I still think this is probably a bug...what do people think ?

Here's the steps to repro (Visio 2003, Windows XP).

1. Create a new blank sheet, create two shapes, double-click, add some text.
2. Enable Complex Scripts: "Tools | Options | Regional | Complex scripts options" - set to 'Show'.
3. Right click each shape, set up the complex script font to Wingdings (its obvious to see the effect for one).
3. Select both shapes and group them (Right-Click | Shape | Group).
4. Now Right Click the new grouped shape, change the complex script to blank - this will work. Undo the action.
5. Now run the VBA (included below for reference): this will NOT work. [even if you record step 4 as a macro and replay].
6. Now ungroup the shapes again, run the VBA - this WILL work.

QUESTION: Do I need to iterate these shapes differently to pick up grouped shapes ? I don't want to programmatically ungroup shapes - not least because I get this : "This action will sever the object's link to its master." , which I presume is one-way...

Further info: after step 4 [but don't undo], and then ungroup - you can see the action performs more than the VBA - it rolls through the complex font to the sub shapes.

Here's the VBA I'm using for reference:

-- Cut Here --
Sub Remove_Complex_Fonts()
Dim shapeObject As Visio.Shape
Dim cellObject As Visio.Cell
Dim Count As Integer

For Count = 1 To ActivePage.Shapes.Count
    Set shapeObject = ActivePage.Shapes(Count)
    Set cellObject = shapeObject.Cells("Char.ComplexScriptFont")
    cellObject.Formula = 0
Next Count

End Sub
-- Cut Here --

[JuneTheSecond]

Hi,

The simplest is to use ItemFromID property.
Shapes.ItemFromID(ID) can access any shape in the group or not in the group.
But you need to know max. number of ID to iterate really all shapes.
Or you need to use error trap.

Code

Sub test()
    On Error GoTo ERRMSG
    
    Dim I As Long
    Dim shp As Visio.Shape
    For I = 1 To 300 ' or 3000 or 30000
        Set shp = ActivePage.Shapes.ItemFromID(I)
        Debug.Print shp.Index, shp.ID, shp.NameU, shp.Type
    Next
    
    Exit Sub
ERRMSG:

End Sub

If you delete any shape, then it losts ID and iteration stops there.

Another right way is iterate shapes in each group with Shapes(I).Shapes(J) property, if the type property is group.
But if a group includes other groups, say multi stage group, a simple loop cannot detect all shapes in the groups. You might need to use recursive calls.

[monojohnny]

Thanks for the post: for reference the following function does what I need: I note the previous posters comment about having to recursive groups of groups really to do this properly - but this more naive approach works for me - might be useful to other people:

Sub Remove_Complex_Fonts()

Dim shapeObject, subShapeObject As Visio.Shape
Dim cellObject, subCellObject As Visio.Cell
Dim Count, subCount As Integer

For Count = 1 To ActivePage.Shapes.Count
    Set shapeObject = ActivePage.Shapes(Count)
    Set cellObject = shapeObject.Cells("Char.ComplexScriptFont")
   
    If cellObject.Formula <> "0" Then
        cellObject.Formula = "0"
    End If
   
    For subCount = 1 To shapeObject.Shapes.Count
        Set subShapeObject = shapeObject.Shapes(subCount)
        Set subCellObject = subShapeObject.Cells("Char.ComplexScriptFont")
        If subCellObject.Formula <> "0" Then
            subCellObject.Formula = "0"
        End If
    Next subCount
   
Next Count
End Sub