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
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
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
so it copies the Master to the document. I open the VBA Editor (Alt+F11) andOrganization Chart and I drag the Doted-line report master on to the page
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