Callout using VBA to show display fields

[Shahzad Godil]

My requirement is that I want to provide Custom Callout for each shape.
That custom callout will show custom properties for attached parent object.
Here is my code working pefectly for adding Custom Callout 1 automatically
with new shape. But it is opening dialog box also.

Open attached file and try to drop one "Process" from stencil. Here is the
code working right now

Here is the changes which I want in it.

1. This dialog box should not be open automatically.
2. All custom property should automatically checked in Callout dialog box by
default. Means default behaviour will be that a callout object will also
create with orignal shape. And it will show all properties without asking
to user.
3. I tried to set

I also tried to set properties "User.ccReportOn", User.ccParentName etc at
runtime using code but it also didn't worked.


Private Sub Document_ShapeAdded(ByVal Shape As IVShape)
If Shape.Master = "Process" Then
Dim objCallout As Shape
Set objCallout = Module1.DropMasterOnPage(Me.Pages(1), "Custom
callout 1", "CALOUT_U.VSS", Shape.Cells("PinX"), Shape.Cells("PinY") -
Shape.Cells("Height"), visInches)

Dim vsoCell1 As Visio.Cell
Dim vsoCell2 As Visio.Cell

Set vsoCell1 = objCallout.CellsSRC(visSectionControls, 0, visCtlX)
Set vsoCell2 = Shape.CellsSRC(7, 1, 0)

vsoCell1.GlueTo vsoCell2


End If
End Sub

 

[JuneTheSecond]

And where is the DropMasterOnPage?

 

[Shahzad Godil]

DropMasterOnPage is module function copied from visio sdk code library.

' modDropMasterOnPage / DropMasterOnPage.bas
' Copyright (c) Microsoft Corporation. All rights reserved.
'
' Summary:
' This module demonstrates how to drop a master onto a page at a
' specific location.


Public Function DropMasterOnPage(vsoPage As Visio.Page, _
strMasterNameU As String, _
strStencilName As String, _
dblPinX As Double, _
dblPinY As Double, _
varUnits As Variant) As Visio.Shape

' DropMasterOnPage
'
' Abstract - This function finds the document with the
' strStencilName parameter from the Documents collection.
' If the document is not open, then open the stencil. Find
' the master within that stencil and drop it on to the page.
'
' Parameters
' vsoPage The page where the master will be dropped
' strMasterNameU Universal name of master in the stencil
' strStencilName Name of the Stencil from which the master
' is to be found
' dblPinX X-coordinate of the Pin in varUnits units
' dblPinY Y-coordinate of the Pin in varUnits units
' varUnits Units used by dblPinX and dblPinY
'
' Return Value Shape that was created by dropping the master on the page
' indicated by the vsoPage parameter

Dim vsoApplication As Visio.Application
Dim vsoDocuments As Visio.Documents
Dim vsoDocument As Visio.Document
Dim vsoMaster As Visio.Master
Dim dblPinXInternal As Double
Dim dblPinYInternal As Double
Dim vsoCellPinX As Visio.Cell
Dim vsoCellPinY As Visio.Cell

On Error Resume Next

' Find the stencil in the Document collection by name.
Set vsoDocuments = vsoPage.Application.Documents
Set vsoDocument = vsoDocuments.Item(strStencilName)

' If the stencil is not there, open it as a
' docked stencil.
If vsoDocument Is Nothing Then
Set vsoDocument = vsoDocuments.OpenEx( _
strStencilName, visOpenDocked)
End If

On Error GoTo DropMasterOnPage_Err

' Get the master on the stencil by using its universal
' name.
Set vsoMaster = vsoDocument.Masters.ItemU( _
strMasterNameU)

' Convert the PinX and PinY into internal units
Set vsoApplication = vsoPage.Application
dblPinXInternal = vsoApplication.ConvertResult(dblPinX, _
varUnits, visInches)
dblPinYInternal = vsoApplication.ConvertResult(dblPinY, _
varUnits, visInches)

' Drop the master on the page that is passed in.
' Set the PinX and PinY using the parameters
' dblPinXInternal and dblPinYInternal respectively.
Set DropMasterOnPage = vsoPage.Drop(vsoMaster, _
dblPinXInternal, dblPinYInternal)

' Update the units of the shape's PinX and PinY
Set vsoCellPinX = DropMasterOnPage.CellsSRC(visSectionObject, _
visRowXFormOut, visXFormPinX)
Set vsoCellPinY = DropMasterOnPage.CellsSRC(visSectionObject, _
visRowXFormOut, visXFormPinY)

vsoCellPinX.Result(varUnits) = dblPinX
vsoCellPinY.Result(varUnits) = dblPinY

Exit Function

DropMasterOnPage_Err:
Debug.Print Err.Description

End Function

 

[JuneTheSecond]

One of the alternatives might be for you to make your own shape that does not
display the callout but extract custom property from the parent shape, though
you might have to make a new program to replace "cc" called in a user defined
cell. In this case ConnectionsAdded event in VBA might be used.