I have an orgchart (fully expanded) and I had some code I used last April to grab EMF files and place them in the orgchart to provide more information. I just tried to recreate my orgcharts with updated data, and for some reason it isn't working as expected.
The target (active) sheet has a total of about 129 people.
Application.ActivePage.Shapes.Count = 257
# of connectors (see code below) = 51 (iCount)
# of shapes that run through the upper code block = 206 (iCount2)
Each shape has 4 data fields; name, location, title, and User ID. The first 3 are visible on the shape, whereas the User ID is a hidden data field. User ID is a 5-digit string, but only the last 3 digits are unique. The EMF files are named with just the 3 digits, which is why this code has to parse them out the 3-digit User ID.
The problem? Only about 38 of the shapes are receiving the EMF files. I checked one of the shapes that didn't get an EMF file imported with this code, and the User ID is in that shape just like the others, and there is an appropriately named EMF file.
I'd really appreciate it if you could take a look at the code, and see if there is some obvious reason that it would be skipping a bunch of my shapes!
The only other thing I'm not sure about- the field from Excel was "User ID" but when referencing the property (even though it is in quotes) it won't accept "prop.User ID" [it errors out]- it only runs when I use "prop.UserID" without the space.
Sub ShapesCount()
'Return value
Dim iCount As Integer
'Shapes collection
Dim shpsObj As Visio.Shapes
'Shape object
Dim shpObj As Visio.Shape
iCount = 0
'Assumes root.Shapes is a group or a page
ShpsCount = Application.ActivePage.Shapes.Count
Set shpsObj = Application.ActivePage.Shapes ' root.Shapes
For UseShpObj = ShpsCount To 1 Step -1
Set shpObj = shpsObj(UseShpObj)
If shpObj.Type = visTypeGroup And shpObj.Style <> "Connector" Then
iCount2 = iCount2 + 1
'NOTE: whatever comes after "Prop." has to match the
'name of the background field that was added from Excel
a3 = shpObj.Cells("Prop.UserID").ResultStr(Visio.VisUnitCodes.visNoCast) 'returned as basic string
a3 = UCase(Right(Trim(a3), 3)) 'get the unique 3-char string User ID
Debug.Print "." & a3
'note: only 44 items are debug/printed here, instead of 129, so the issue is above this line
If a3 = "DAH" Then MsgBox "stop here" 'this line is never triggered
b1 = shpObj.Cells("PinX").ResultIU
b2 = shpObj.Cells("PinY").ResultIU
b3 = shpObj.Cells("Height").ResultIU
b4 = shpObj.Cells("Width").ResultIU
HalfHeight = b3 * 0.5
UpperPinY = b2 + (HalfHeight * 0.5)
LowerPinY = b2 - (HalfHeight * 0.5)
'Right now, this uses the same two filenames, later it will use two different files
MyFileName = "C:\Documents and Settings\iezac\Desktop\Jane Charts\Colors3\" & a3 & "_all.emf"
MyFileName2 = "C:\Documents and Settings\iezac\Desktop\Jane Charts\Colors3\" & a3 & "_all.emf"
If Dir(MyFileName) <> "" Then
shpObj.Cells("FillPattern").FormulaU = 0
With Application.ActiveWindow
Set vsoShape = .Page.Import(MyFileName)
On Error GoTo 0
vsoShape.Cells("PinX").FormulaU = b1
vsoShape.Cells("PinY").FormulaU = UpperPinY
vsoShape.Cells("Height").FormulaU = HalfHeight
vsoShape.Cells("Width").FormulaU = b4
vsoShape.SendToBack
End With
End If
If Dir(MyFileName2) <> "" Then
shpObj.Cells("FillPattern").FormulaU = 0
With Application.ActiveWindow
Set vsoShape = .Page.Import(MyFileName2)
On Error GoTo 0
vsoShape.Cells("PinX").FormulaU = b1
vsoShape.Cells("PinY").FormulaU = LowerPinY
vsoShape.Cells("Height").FormulaU = HalfHeight
vsoShape.Cells("Width").FormulaU = b4
vsoShape.SendToBack
End With
End If
Else
iCount = iCount + 1
If shpObj.Style <> "Connector" Then
Debug.Print shpObj.Text
End If
End If
Next
MsgBox iCount & vbCrLf & iCount2
End Sub
Here is an interesting observation- I just noticed that while the majority of the shapes with EMF files remains stable, there appears to be some variation. The code makes the Visio shape transparent (the EMF goes behind it).
Each time I re-run it, I start by deleting all non-visio shapes from the sheet (which gets rid of the EMF shapes as expected).
As I look closely, I see some shapes that are transparent but are not receiving an EMF shape with each run- so they must have gotten them at one time, but aren't now. I also had one of the ones I was testing show up on two runs without any changes to the code.
I added a DoEvents, in case it was strictly a timing thing, but that didn't have a noticable effect. Maybe I need a 1-s delay in there somewhere? The question is where...
Thanks for your continued support,
Keith
After a very quick look at your code, be very careful, your loop through all the shapes is effectively being modfied by the code "vsoShape.SendToBack", SendToBack changes the order of the shapes in the shapes collection.
ooooohhhh. I didn't realize that would change the order. Sounds like I need to loop all the shapes before starting and identify them in a separate array that will remain in the original order, rather than dynamically going through them on the page. I'll go try that, and report back when I've got it running to confirm the results.
Thanks!!
Keith
This appears to have worked! Now I'll go back and cross reference the original data to make sure things are ending up where they should, but it looks like all the EMF files are loading- thank you thank you thank you!
Best,
Keith
Sub ShapesCount()
'Shapes collection
Dim shpsObj As Visio.Shapes
'Shape object
Dim shpObj As Visio.Shape
'NEW: Copy of original array of shapes to avoid changing order with "SendToBack"
Dim ShpsArray()
'Assumes root.Shapes is a group or a page
ShpsCount = Application.ActivePage.Shapes.Count
Set shpsObj = Application.ActivePage.Shapes ' root.Shapes
'NEW: make a copy of the original list of shapes
ReDim ShpsArray(1 To ShpsCount)
For UseShpObj = 1 To ShpsCount
Set ShpsArray(UseShpObj) = shpsObj(UseShpObj)
Next
For UseShpObj = 1 To ShpsCount 'To 1 Step -1
Set shpObj = ShpsArray(UseShpObj) '<-- RTE 424, object required
<snip>
Hello,
some general questions about loops (I asked myself because of this code)
KeithRuck and several other examples I've seen here and elsewhere on the web loop through the Shapes on the page with Indexnumber like
For i = 1 to ...Shapes.Count
debug.Print shp(i).Name
Next
or they count backwards like KeithRuck
For i = ...Shapes.Count To 1 Step -1
debug.Print shp(i).Name
Next
First question: Is there a difference between those two code examples, a reason why one is used and not the other?
Second question: When I had to loop through all the Shapes I used sth. like this:
For Each shp in ActivePage.Shapes
debug.Print shp.Name
Next
I seldom saw this kind of loop and asked myself, is it not good two use it so? Are the ones above better? And if so, why?
Would this loop also have been affected by the error above?
I'm new to programming (Visio) and still learning and optimizing my code and therefore would be thankfull if one of the old hands had time for a little lesson and could answer my questions.
Thanks,
Jumpy
P.S.: Feel free to move this post, if you think it doesn't belong here, or should be a new thread.