Automating Connection using GetShapesByData code

A

arka

Hi, I'm trying to make a general automation tool for shape-to-shape
connectivity. First I used David J. Parker's code GetShapesByData to find the
shapes to be connected at either end of a connector. This GetShapeByData
function enables me to get a list of shapes that contain given shape data
values, so now I need to be able to use these lists to create connections
automatically. Then I use Data>Link Data to Shape and select DBSAMPLE.MDB
that comes in c:\program files\microsoft office\office12\1033 to get the
Organization Chart Data table. The filed names do not match with the labels
of the shape data rows on the Person Master of the Space Plan diagram so I
edited the Belongs_To column of the External Data Window to Manager. Now I
open the Organization Chart Shapes stencil from the File > Shapes > Business
Organization Chart and I drag the Doted-line report master on to the page
so it copies the Master to the document. I open the VBA Editor (Alt+F11) and
created a new module and paste the GetShapesByData and its supporting
functions. I then created another new module and copy paste the
ConnectSubOrdinates functions. The error occur when I run (call) this
ConnectSubOrdinates functions when it suppose to automatically connect shape
to shape according to the organization chart data but it doesn't.

The code keeps poping out error for the AutoConnect part of the code.
Can anyone tell me how to fix this? I basically want all Person to be
connected to the appropriate manager.

Here's the code:

Public Sub ConnectSubOrdinates()
Dim pag As Visio.Page
Dim shp As Visio.Shape
Dim subshp As Visio.Shape
Dim shpConnector As Visio.Shape
Dim shapeCounter As Integer
Dim manager As String
Dim mst As Visio.Master

Set mst = ThisDocument.Masters("Dotted-line report")

Visio.Application.EventsEnabled = False

For Each shp In Visio.ActivePage.Shapes
'Cek jika shape kualifikasi
If shp.CellExists("Prop.Name", Visio.visExistsAnywhere) = True _
And shp.CellExists("Prop.Manager", Visio.visExistsAnywhere) = True Then
manager = shp.Cells("Prop.Name").ResultStr("")
'Dapatkan list subordinate shape
Dim foundShapes() As Long
If FindMySubordinates(manager, foundShapes) = True Then
For shapeCounter = 1 To UBound(foundShapes, 2)
Set pag = Visio.ActiveDocument.Pages.ItemFromID(foundShapes(1,
shapeCounter))
Set subshp = pag.Shapes.ItemFromID(foundShapes(2, shapeCounter))
''''EITHER use AutoConnect
''''AutoConnect will cause the page layout to be triggered
''''AutoConnect without a Master will use Dynamic Connector
'shp.AutoConnect subshp, visAutoConnectDirDown
'AutoConnect with a connector Master
shp.AutoConnect subshp, visAutoConnectDirNone, mst
'Get a reference to the last shape (the connector)
Set shpConnector = pag.Shapes(pag.Shapes.Count)

'OR use GlueTo
'Drop a new connector shape
'Set shpConnector = pag.Drop(mst, shp.Cells("PinX").ResultIU,
shp.Cells("PinY").ResultIU)

'Glue start to manager
'shpConnector.Cells("BeginX").GlueTo shp.Cells("PinX")
'Glue end to subordinate
'shpConnector.Cells("EndX").GlueTo subshp.Cells("PinX")

'Set properti connector shape yang anda suka
'contohnya pada warna line
shpConnector.Cells("LineColor").Formula = "2" 'merah
shpConnector.Cells("BeginArrow").Formula = "10" 'bundaran kecil
shpConnector.Cells("EndArrow").Formula = "2" 'segitiga kecil
'Properti lainnya yang patut dipertimbangkan adalah layer,
hyperlinks dan data shape

Next shapeCounter
End If
End If
Next shp
Visio.Application.EventsEnabled = True




End Sub



Private Function FindMySubordinates(ByVal manager As String, ByRef
foundShapes() As Long) As Boolean
Dim aryCriteria() As String
'dimensi Array:
' 1 = UseName = "True", UseLabel = "False"
' 2 = Data Name atau Label
' 3 = Nilai (sebagai string)
ReDim aryCriteria(1 To 1, 1 To 3)

aryCriteria(1, 1) = "False"
aryCriteria(1, 2) = "Manager"
aryCriteria(1, 3) = manager

FindMySubordinates = GetShapesByData(False, 1, False, aryCriteria,
foundShapes)


End Function
 
D

David Parker

Well, I just repeated all of your steps and I do not get any errors.
I am using Visio 2007 Pro SP1 on Vista Ultimate - both are English.
What's yours?

If you put a break on:
shp.AutoConnect subshp, visAutoConnectDirNone, mst

Can you confirm that shp, subshp and mst all have values? (ie they are not
Nothing)
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top