Access to Visio Terminator Drawing Error

N

Nocatchyphrase

New member
Local time
Today, 07:26
Joined
Sep 16, 2014
Messages
5
Hey guys! :)

I have an error when trying to programatically create visio drawings from Access. I get a runtime error : Object name not found.

This seems to happen when I try to create a visio flowchart that has the 'terminator' element. when the flowchart only has the 'process' shape I recieve no error.

Might this be something to do with using a newer version of Visio? How would I go about "updating" the shape names to the new version in that case.

When I hit debug it highlights this line:

Code: 
'Draw elements
        VisioApp.Documents.OpenEx "BASFLO_M.VSS", visOpenRO + visOpenDocked
        VisioApp.Documents.OpenEx "FLOSHP_M.VSS", visOpenRO + visOpenDocked
        For j = 0 To ElementsInSwimlaneCount(i) - 1
            If ElementTypesInSwimlane(i)(j) = "Database" Then
                Set AppShapes(i, j) = Diagram.Drop(VisioApp.Documents.Item("FLOSHP_M.VSS").Masters.ItemU(ElementTypesInSwimlane(i)(j)), ElementOffset + j * ElementWidth * ElementPadding + SwimlaneTitleWidth + ElementWidth / 2, PageHeight - HeaderHeight - (i + 0.5) * SwimlaneHeight)
            Else
                Set AppShapes(i, j) = Diagram.Drop(VisioApp.Documents.Item("BASFLO_M.VSS").Masters.ItemU(ElementTypesInSwimlane(i)(j)), ElementOffset + j * ElementWidth * ElementPadding + SwimlaneTitleWidth + ElementWidth / 2, PageHeight - HeaderHeight - (i + 0.5) * SwimlaneHeight)
            End If
            AppShapes(i, j).Text = ElementsInSwimlane(i)(j)
            AppShapes(i, j).CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "10 pt"
            AppShapes(i, j).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = ElementWidth
            AppShapes(i, j).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = ElementHeight
            AppShapes(i, j).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = ElementColorsInSwimlane(i)(j)
 
This specific line:

Code: 
 Set AppShapes(i, j) = Diagram.Drop(VisioApp.Documents.Item("BASFLO_M.VSS").Masters.ItemU(ElementTypesInSwimlane(i)(j)), ElementOffset + j * ElementWidth * ElementPadding + SwimlaneTitleWidth + ElementWidth / 2, PageHeight - HeaderHeight - (i + 0.5) * SwimlaneHeight)
 
You only show a part of you code, so where do you declare AppShapes and as what?
 
Apologies,

Code: 
Dim AppShapes(1000, 1000) As Visio.Shape
    
    'Draw frame
    Call Diagram.DrawRectangle(0, PageHeight, PageWidth, 0)
    
    'Draw header
    Dim Header As Visio.Shape
    Set Header = Diagram.DrawRectangle(0, PageHeight, PageWidth, PageHeight - HeaderHeight)
    Header.TextStyle = "Normal"
    Header.Text = FlowName
    Header.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(200,214,230))"
    Header.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
    Header.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "20 pt"
    Header.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = "17"
    
    For i = 0 To SwimlanesCount - 1
        'Draw text box with swimlane name
        Dim SwimlaneText As Visio.Shape
        Set SwimlaneText = Diagram.DrawRectangle(0, PageHeight - HeaderHeight - (i + 1) * SwimlaneHeight, SwimlaneTitleWidth, PageHeight - HeaderHeight - i * SwimlaneHeight)
        SwimlaneText.TextStyle = "Normal"
        SwimlaneText.Text = Swimlanes(i)
        SwimlaneText.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(200,214,230))"
        SwimlaneText.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
        SwimlaneText.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = "17"
        'Draw line
        Dim SwimlaneLine As Visio.Shape
        Set SwimlaneLine = Diagram.DrawLine(SwimlaneTitleWidth, PageHeight - HeaderHeight - (i + 1) * SwimlaneHeight, PageWidth, PageHeight - HeaderHeight - (i + 1) * SwimlaneHeight)
        SwimlaneLine.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "0.24 pt"
        SwimlaneLine.CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "2"
        'Draw elements
        VisioApp.Documents.OpenEx "BASFLO_M.VSS", visOpenRO + visOpenDocked
        VisioApp.Documents.OpenEx "FLOSHP_M.VSS", visOpenRO + visOpenDocked
        For j = 0 To ElementsInSwimlaneCount(i) - 1
            If ElementTypesInSwimlane(i)(j) = "Database" Then
                Set AppShapes(i, j) = Diagram.Drop(VisioApp.Documents.Item("FLOSHP_M.VSS").Masters.ItemU(ElementTypesInSwimlane(i)(j)), ElementOffset + j * ElementWidth * ElementPadding + SwimlaneTitleWidth + ElementWidth / 2, PageHeight - HeaderHeight - (i + 0.5) * SwimlaneHeight)
            Else
                Set AppShapes(i, j) = Diagram.Drop(VisioApp.Documents.Item("BASFLO_M.VSS").Masters.ItemU(ElementTypesInSwimlane(i)(j)), ElementOffset + j * ElementWidth * ElementPadding + SwimlaneTitleWidth + ElementWidth / 2, PageHeight - HeaderHeight - (i + 0.5) * SwimlaneHeight)
            End If
            AppShapes(i, j).Text = ElementsInSwimlane(i)(j)
            AppShapes(i, j).CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "10 pt"
            AppShapes(i, j).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = ElementWidth
            AppShapes(i, j).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = ElementHeight
            AppShapes(i, j).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = ElementColorsInSwimlane(i)(j)
            'All connection points of the boxes should be outward, so the connections will not overlap and the diagram will be more readable
            AppShapes(i, j).Section(visSectionConnectionPts).Row(0).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            AppShapes(i, j).Section(visSectionConnectionPts).Row(1).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            AppShapes(i, j).Section(visSectionConnectionPts).Row(2).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            AppShapes(i, j).Section(visSectionConnectionPts).Row(3).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            'Delete default shape data
            AppShapes(i, j).DeleteRow visSectionProp, AppShapes(i, j).CellsU("Prop.Cost").Row
            'AppShapes(i, j).DeleteRow visSectionProp, AppShapes(i, j).CellsU("Prop.Duration").Row
            'AppShapes(i, j).DeleteRow visSectionProp, AppShapes(i, j).CellsU("Prop.Resources").Row
        Next j
    Next i
    For i = 0 To ConnsCount - 1


As a beginner to all this, (this has effectively been copied from an online tutorial showing how to link access to visio), I hope the first line is the declaration you are referring to.

I also mention appshapes further on down the code when attempting to draw the connections, but I imagine this is not needed here.

:)
Fearghal
 
Only to eliminate opportunities where it can go wrong, I would start with some hard-coded values on the line where you get the error.
Some thing like:
Code: 
Set AppShapes(1, 1)=SomeHardCodedValue
Afterwards then:
Set AppShapes(i, j)=SomeHardCodedValue
and so on until you find the wrong piece code.
I think you again only show a part of you code, so where do you declare Diagram and as what?
If Diagram comes from Visio, then I think you need to refer to the Visio object, in front on Diagram, something like TheNameOfVisioObjectCreated.Diagram....
 
The full module is below:

Code: 
Option Compare Database

Function GenerateVisioDiagrams(FlowIDs() As Integer, FlowType As String) 'Generate process or data flow diagram in Visio
    Dim FlowName As String
    Dim rs As Recordset, rs1 As Recordset, rs2 As Recordset
    Dim i As Integer, j As Integer, k As Integer, l As Integer
    Dim strSQL As String
    
    'Create arrays with swimlanes and elements
    Dim Swimlanes(1000) As String
    Dim SwimlanesCount As Integer
    Dim ElementsInSwimlane(1000) As Variant
    Dim ElementTypesInSwimlane(1000) As Variant
    Dim ElementColorsInSwimlane(1000) As Variant
    Dim ElementsInSwimlaneCount(1000) As Integer
    Dim Conns(1000) As DiagramConnection
    Dim ConnsCount As Integer
    Dim Temp(1000) As String
    Dim LongestSwimlane As Integer
    SwimlanesCount = 0
    LongestSwimlane = 0
    ConnsCount = 0
    
    'Build database queries and names for the flows to be pictured
    If FlowType = "DataFlow" Then
        If UBound(FlowIDs) = 0 Then
            FlowName = CurrentDb.OpenRecordset("SELECT * FROM T_Flow WHERE FlowID = " & FlowIDs(0)).Fields("FlowName") & " - Data Flow"
        Else
            FlowName = "Master Data Flow"
        End If
        strSQL = "SELECT T_DataFlow.DataFlowElementID AS FlowElementID, T_SubFunction.SubFunction AS SubFunctionA, T_SubFunction_1.SubFunction AS SubFunctionB, T_Application.ApplicationName AS ElementA, T_Application.InvestmentStatus AS InvStatusA, T_Application_1.ApplicationName AS ElementB, T_Application_1.InvestmentStatus AS InvStatusB, T_DataFlow.TypeA AS TypeA, T_DataFlow.TypeB AS TypeB " & _
        "FROM T_Flow INNER JOIN (T_Application AS T_Application_1 INNER JOIN (T_Application INNER JOIN (T_SubFunction AS T_SubFunction_1 INNER JOIN (T_SubFunction INNER JOIN T_DataFlow ON T_SubFunction.SubFunctionID = T_DataFlow.SubFunctionA) ON T_SubFunction_1.SubFunctionID = T_DataFlow.SubFunctionB) ON T_Application.ApplicationID = T_DataFlow.ApplicationA) ON T_Application_1.ApplicationID = T_DataFlow.ApplicationB) ON T_Flow.FlowID = T_DataFlow.Flow " & _
        "WHERE T_DataFlow.Flow = " & FlowIDs(0) & " "
        If UBound(FlowIDs) > 0 Then
            For i = 1 To UBound(FlowIDs)
                strSQL = strSQL & "Or T_DataFlow.Flow = " & FlowIDs(i) & " "
            Next i
        End If
        strSQL = strSQL & "ORDER BY T_Flow.SortOrder, T_DataFlow.SortOrder"
    Else
        If UBound(FlowIDs) = 0 Then
            FlowName = CurrentDb.OpenRecordset("SELECT * FROM T_Flow WHERE FlowID = " & FlowIDs(0)).Fields("FlowName") & " - Process Flow"
        Else
            FlowName = "Master Process Flow"
        End If
        strSQL = "SELECT T_SubFunction.SubFunction AS SubFunctionA, T_SubFunction_1.SubFunction AS SubFunctionB, T_ProcessFlow.ProcessA AS ElementA, T_ProcessFlow.ProcessB AS ElementB, T_ProcessFlow.TypeA AS TypeA, T_ProcessFlow.TypeB AS TypeB, T_ProcessFlow.Data AS Data " & _
        "FROM T_Flow INNER JOIN (T_SubFunction AS T_SubFunction_1 INNER JOIN (T_SubFunction INNER JOIN T_ProcessFlow ON T_SubFunction.SubFunctionID = T_ProcessFlow.SubFunctionA) ON T_SubFunction_1.SubFunctionID = T_ProcessFlow.SubFunctionB) ON T_Flow.FlowID = T_ProcessFlow.Flow " & _
        "WHERE T_ProcessFlow.Flow = " & FlowIDs(0) & " "
        If UBound(FlowIDs) > 0 Then
            For i = 1 To UBound(FlowIDs)
                strSQL = strSQL & "Or T_ProcessFlow.Flow = " & FlowIDs(i) & " "
            Next i
        End If
        strSQL = strSQL & "ORDER BY T_Flow.SortOrder, T_ProcessFlow.SortOrder"
    End If
    Set rs = CurrentDb.OpenRecordset(strSQL)
    
    'Populate arrays with swimlanes, its elements and connections
    If Not (rs.EOF And rs.BOF) Then
        Do Until rs.EOF = True
            If InArray(rs!SubFunctionA, Swimlanes) = -1 Then 'If swimlane A is not in the array, add it
                Swimlanes(SwimlanesCount) = rs!SubFunctionA
                ElementsInSwimlane(SwimlanesCount) = Temp
                ElementTypesInSwimlane(SwimlanesCount) = Temp
                ElementColorsInSwimlane(SwimlanesCount) = Temp
                ElementsInSwimlaneCount(SwimlanesCount) = 0
                SwimlanesCount = SwimlanesCount + 1
            End If
            If InArray(rs!SubFunctionB, Swimlanes) = -1 Then 'If swimlane B is not in the array, add it
                Swimlanes(SwimlanesCount) = rs!SubFunctionB
                ElementsInSwimlane(SwimlanesCount) = Temp
                ElementTypesInSwimlane(SwimlanesCount) = Temp
                ElementColorsInSwimlane(SwimlanesCount) = Temp
                ElementsInSwimlaneCount(SwimlanesCount) = 0
                SwimlanesCount = SwimlanesCount + 1
            End If
            
            For i = 0 To SwimlanesCount - 1
                If (Swimlanes(i) = rs!SubFunctionA) Then
                    Conns(ConnsCount).SwimlaneA = i
                    If InArray(rs!ElementA, ElementsInSwimlane(i)) = -1 Then 'If element A is not already in the swimlane, add it
                        ElementsInSwimlane(i)(ElementsInSwimlaneCount(i)) = rs!ElementA
                        ElementTypesInSwimlane(i)(ElementsInSwimlaneCount(i)) = rs!TypeA
                        ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(238,242,247))" 'default color
                        If FlowType = "DataFlow" Then
                            If InStr(rs!InvStatusA, "Buy") Then
                                ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(184,224,139))" 'green for buy
                            ElseIf InStr(rs!InvStatusA, "Sell") Then
                                ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(255,130,98))" 'red for sell
                            ElseIf InStr(rs!InvStatusA, "Hold") Then
                                ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(255,224,159))" 'amber for hold
                            End If
                        End If
                        ElementsInSwimlaneCount(i) = ElementsInSwimlaneCount(i) + 1
                    End If
                    Conns(ConnsCount).ElementA = InArray(rs!ElementA, ElementsInSwimlane(i))
                End If
                If (Swimlanes(i) = rs!SubFunctionB) Then
                    Conns(ConnsCount).SwimlaneB = i
                    If InArray(rs!ElementB, ElementsInSwimlane(i)) = -1 Then 'If element B is not already in the swimlane, add it
                        ElementsInSwimlane(i)(ElementsInSwimlaneCount(i)) = rs!ElementB
                        ElementTypesInSwimlane(i)(ElementsInSwimlaneCount(i)) = rs!TypeB
                        ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(238,242,247))" 'default color
                        If FlowType = "DataFlow" Then
                            If InStr(rs!InvStatusB, "Buy") Then
                                ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(184,224,139))" 'green for buy
                            ElseIf InStr(rs!InvStatusB, "Sell") Then
                                ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(255,130,98))" 'red for sell
                            ElseIf InStr(rs!InvStatusB, "Hold") Then
                                ElementColorsInSwimlane(i)(ElementsInSwimlaneCount(i)) = "THEMEGUARD(RGB(255,224,159))" 'amber for hold
                            End If
                        End If
                        ElementsInSwimlaneCount(i) = ElementsInSwimlaneCount(i) + 1
                    End If
                    Conns(ConnsCount).ElementB = InArray(rs!ElementB, ElementsInSwimlane(i))
                End If
                If (ElementsInSwimlaneCount(i) > LongestSwimlane) Then LongestSwimlane = ElementsInSwimlaneCount(i)
            Next i
            
            If FlowType = "DataFlow" Then
                Conns(ConnsCount).DCNum = 0
                Conns(ConnsCount).Text = ""
                
                'Read data concepts
                Set rs1 = CurrentDb.OpenRecordset("SELECT ConceptID, ConceptName FROM T_DataConceptL2 INNER JOIN T_DataFlowConcept " & _
                "ON T_DataFlowConcept.Concept = T_DataConceptL2.ConceptID " & _
                "WHERE DataFlowElement = " & rs!FlowElementID & " ORDER BY ConceptName")
                If Not (rs1.EOF And rs1.BOF) Then
                    Do Until rs1.EOF = True
                        Conns(ConnsCount).DataConcepts(Conns(ConnsCount).DCNum) = rs1!ConceptName
                        If Conns(ConnsCount).DCNum > 0 Then
                            Conns(ConnsCount).Text = Conns(ConnsCount).Text & ", "
                        End If
                        Conns(ConnsCount).Text = Conns(ConnsCount).Text & rs1!ConceptName
                        
                        Set rs2 = CurrentDb.OpenRecordset("SELECT ElementID, ElementName FROM T_DataElement INNER JOIN T_DataFlowConceptElement " & _
                        "ON T_DataElement.ElementID = T_DataFlowConceptElement.Element " & _
                        "WHERE Concept = " & rs1!ConceptID & " And DataFlowElement = " & rs!FlowElementID & " ORDER BY ElementName")
                        If Not (rs2.EOF And rs2.BOF) Then
                            Do Until rs2.EOF = True
                                Conns(ConnsCount).DataElements(Conns(ConnsCount).DCNum, Conns(ConnsCount).DENum(Conns(ConnsCount).DCNum)) = rs2!ElementName
                                Conns(ConnsCount).DENum(Conns(ConnsCount).DCNum) = Conns(ConnsCount).DENum(Conns(ConnsCount).DCNum) + 1
                                rs2.MoveNext
                            Loop
                        End If
                        rs2.Close
                        
                        Conns(ConnsCount).DCNum = Conns(ConnsCount).DCNum + 1
                        rs1.MoveNext
                    Loop
                End If
                rs1.Close
            Else
                Conns(ConnsCount).Text = Nz(rs!Data)
            End If
            ConnsCount = ConnsCount + 1
            rs.MoveNext
        Loop
    Else
        MsgBox "This flow is empty.", vbInformation, "Generate diagram"
        Exit Function
    End If
    rs.Close
    
    'Open Visio and create new file
    Dim VisioApp As Visio.Application
    Dim VisioFile As Visio.Document
    Dim Diagram As Visio.Page
    
    Set VisioApp = CreateObject("Visio.Application")
    Set VisioFile = VisioApp.Documents.Add("")
    Set Diagram = VisioFile.Pages(1)
    Diagram.Name = FlowName
    
    
    Dim PageWidth As Double
    Dim PageHeight As Double
    PageWidth = SwimlaneTitleWidth + ElementOffset + LongestSwimlane * ElementWidth * ElementPadding
    PageHeight = SwimlanesCount * SwimlaneHeight + HeaderHeight
    Diagram.PageSheet.CellsU("PageWidth").ResultIU = PageWidth
    Diagram.PageSheet.CellsU("PageHeight").ResultIU = PageHeight
    
    'Set diagram layout parameters
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOLineToNodeX).FormulaForceU = "20 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOLineToNodeY).FormulaForceU = "20 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOBlockSizeX).FormulaForceU = "40 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOBlockSizeY).FormulaForceU = "20 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOAvenueSizeX).FormulaForceU = "25 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOAvenueSizeY).FormulaForceU = "20 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOLineToLineX).FormulaForceU = "20 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOLineToLineY).FormulaForceU = "20 mm"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOJumpFactorX).FormulaForceU = "0.233"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOJumpFactorY).FormulaForceU = "0.233"
    Diagram.PageSheet.CellsSRC(visSectionObject, visRowPageLayout, visPLOLineAdjustFrom).FormulaForceU = "1"
    
    Dim AppShapes(1000, 1000) As Visio.Shape
    
    'Draw frame
    Call Diagram.DrawRectangle(0, PageHeight, PageWidth, 0)
    
    'Draw header
    Dim Header As Visio.Shape
    Set Header = Diagram.DrawRectangle(0, PageHeight, PageWidth, PageHeight - HeaderHeight)
    Header.TextStyle = "Normal"
    Header.Text = FlowName
    Header.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(200,214,230))"
    Header.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
    Header.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "20 pt"
    Header.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = "17"
    
    For i = 0 To SwimlanesCount - 1
        'Draw text box with swimlane name
        Dim SwimlaneText As Visio.Shape
        Set SwimlaneText = Diagram.DrawRectangle(0, PageHeight - HeaderHeight - (i + 1) * SwimlaneHeight, SwimlaneTitleWidth, PageHeight - HeaderHeight - i * SwimlaneHeight)
        SwimlaneText.TextStyle = "Normal"
        SwimlaneText.Text = Swimlanes(i)
        SwimlaneText.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(200,214,230))"
        SwimlaneText.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
        SwimlaneText.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = "17"
        'Draw line
        Dim SwimlaneLine As Visio.Shape
        Set SwimlaneLine = Diagram.DrawLine(SwimlaneTitleWidth, PageHeight - HeaderHeight - (i + 1) * SwimlaneHeight, PageWidth, PageHeight - HeaderHeight - (i + 1) * SwimlaneHeight)
        SwimlaneLine.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "0.24 pt"
        SwimlaneLine.CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "2"
        'Draw elements
        VisioApp.Documents.OpenEx "BASFLO_M.VSS", visOpenRO + visOpenDocked
        VisioApp.Documents.OpenEx "FLOSHP_M.VSS", visOpenRO + visOpenDocked
        For j = 0 To ElementsInSwimlaneCount(i) - 1
            If ElementTypesInSwimlane(i)(j) = "Database" Then
                Set AppShapes(i, j) = Diagram.Drop(VisioApp.Documents.Item("FLOSHP_M.VSS").Masters.ItemU(ElementTypesInSwimlane(i)(j)), ElementOffset + j * ElementWidth * ElementPadding + SwimlaneTitleWidth + ElementWidth / 2, PageHeight - HeaderHeight - (i + 0.5) * SwimlaneHeight)
            Else
                Set AppShapes(i, j) = Diagram.Drop(VisioApp.Documents.Item("BASFLO_M.VSS").Masters.ItemU(ElementTypesInSwimlane(i)(j)), ElementOffset + j * ElementWidth * ElementPadding + SwimlaneTitleWidth + ElementWidth / 2, PageHeight - HeaderHeight - (i + 0.5) * SwimlaneHeight)
            End If
            AppShapes(i, j).Text = ElementsInSwimlane(i)(j)
            AppShapes(i, j).CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "10 pt"
            AppShapes(i, j).CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = ElementWidth
            AppShapes(i, j).CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = ElementHeight
            AppShapes(i, j).CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = ElementColorsInSwimlane(i)(j)
            'All connection points of the boxes should be outward, so the connections will not overlap and the diagram will be more readable
            AppShapes(i, j).Section(visSectionConnectionPts).Row(0).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            AppShapes(i, j).Section(visSectionConnectionPts).Row(1).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            AppShapes(i, j).Section(visSectionConnectionPts).Row(2).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            AppShapes(i, j).Section(visSectionConnectionPts).Row(3).Cell(visCnnctType).FormulaU = visCnnctTypeOutward
            'Delete default shape data
            AppShapes(i, j).DeleteRow visSectionProp, AppShapes(i, j).CellsU("Prop.Cost").Row
            'AppShapes(i, j).DeleteRow visSectionProp, AppShapes(i, j).CellsU("Prop.Duration").Row
            'AppShapes(i, j).DeleteRow visSectionProp, AppShapes(i, j).CellsU("Prop.Resources").Row
        Next j
    Next i
    For i = 0 To ConnsCount - 1
        'Draw connections
        Dim Connector As Visio.Shape
        Set Connector = Diagram.Drop(VisioApp.Documents.Item("BASFLO_M.VSS").Masters.ItemU("Dynamic connector"), 0#, 0#)
        Connector.CellsSRC(visSectionObject, visRowLine, visLineArrowSize).FormulaU = "3"
        Connector.CellsSRC(visSectionObject, visRowLine, visLineBeginArrowSize).FormulaU = "3"
        Connector.CellsSRC(visSectionObject, visRowLine, visLineWeight).FormulaU = "1.2 pt"
        If FlowType = "DataFlow" Then
            Connector.Text = (i + 1) & ". " & Conns(i).Text
        Else
            Connector.Text = Conns(i).Text
        End If
        Connector.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "10 pt"
        Dim vsoCell1 As Visio.Cell
        Dim vsoCell2 As Visio.Cell
        Set vsoCell1 = Connector.CellsU("BeginX")
        Set vsoCell2 = AppShapes(Conns(i).SwimlaneA, Conns(i).ElementA).CellsSRC(1, 1, 0)
        vsoCell1.GlueTo vsoCell2
        Set vsoCell1 = Connector.CellsU("EndX")
        Set vsoCell2 = AppShapes(Conns(i).SwimlaneB, Conns(i).ElementB).CellsSRC(1, 1, 0)
        vsoCell1.GlueTo vsoCell2
    Next i
    
    If FlowType = "DataFlow" Then
        'Add additional sheet with parameters
        Dim ParameterPage As Visio.Page
        Set ParameterPage = VisioFile.Pages.Add
        ParameterPage.Name = "Parameters"
        
        
        Dim ParameterPageWidth As Double
        Dim ParameterPageHeight As Double
        Dim ParameterRowHeights(1000) As Double
        ParameterPageWidth = ParameterFirstColumnWidth + ParameterColumnWidth * 5 + ParameterLastColumnWidth
        ParameterPageHeight = HeaderHeight * 2
        For i = 0 To ConnsCount - 1
            ParameterRowHeights(i) = ParameterSubrowHeight
            If Conns(i).DCNum > 1 Then ParameterRowHeights(i) = ParameterSubrowHeight * Conns(i).DCNum
            ParameterPageHeight = ParameterPageHeight + ParameterRowHeights(i)
        Next i
        ParameterPage.PageSheet.CellsU("PageWidth").ResultIU = ParameterPageWidth
        ParameterPage.PageSheet.CellsU("PageHeight").ResultIU = ParameterPageHeight
        
        'Draw header
        Set Header = ParameterPage.DrawRectangle(0, ParameterPageHeight, ParameterPageWidth, ParameterPageHeight - HeaderHeight)
        Header.TextStyle = "Normal"
        Header.Text = FlowName
        Header.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(200,214,230))"
        Header.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
        Header.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "20 pt"
        Header.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = "17"
        
        'Draw table headings
        Dim TableCell As Visio.Shape
        Dim Headings(6) As String
        Headings(0) = "No"
        Headings(1) = "Provider sub-function"
        Headings(2) = "Provider application"
        Headings(3) = "Consumer sub-function"
        Headings(4) = "Consumer application"
        Headings(5) = "Data concepts"
        Headings(6) = "Data elements"
        For i = 0 To 6
            If i = 0 Then
                Set TableCell = ParameterPage.DrawRectangle(0, ParameterPageHeight - HeaderHeight, ParameterFirstColumnWidth, ParameterPageHeight - HeaderHeight * 2)
            ElseIf i = 6 Then
                Set TableCell = ParameterPage.DrawRectangle(ParameterFirstColumnWidth + ParameterColumnWidth * (i - 1), ParameterPageHeight - HeaderHeight, ParameterFirstColumnWidth + ParameterColumnWidth * (i - 1) + ParameterLastColumnWidth, ParameterPageHeight - HeaderHeight * 2)
            Else
                Set TableCell = ParameterPage.DrawRectangle(ParameterFirstColumnWidth + ParameterColumnWidth * (i - 1), ParameterPageHeight - HeaderHeight, ParameterFirstColumnWidth + ParameterColumnWidth * i, ParameterPageHeight - HeaderHeight * 2)
            End If
            TableCell.TextStyle = "Normal"
            TableCell.Text = Headings(i)
            TableCell.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "THEMEGUARD(RGB(200,214,230))"
            TableCell.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "1"
            TableCell.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "16 pt"
            TableCell.CellsSRC(visSectionCharacter, 0, visCharacterStyle).FormulaU = "17"
        Next i
        
        'Draw connections table
        Dim DrawingPosition As Double
        DrawingPosition = ParameterPageHeight - HeaderHeight * 2
        For i = 0 To ConnsCount - 1
            For j = 0 To 6
                If j = 0 Then
                    Set TableCell = ParameterPage.DrawRectangle(0, DrawingPosition - ParameterRowHeight, ParameterFirstColumnWidth, DrawingPosition - ParameterRowHeights(i))
                ElseIf j = 6 Then
                    Set TableCell = ParameterPage.DrawRectangle(ParameterFirstColumnWidth + ParameterColumnWidth * (j - 1), DrawingPosition - ParameterRowHeight, ParameterFirstColumnWidth + ParameterColumnWidth * (j - 1) + ParameterLastColumnWidth, DrawingPosition - ParameterRowHeights(i))
                    Set TableCell = ParameterPage.DrawRectangle(ParameterFirstColumnWidth + ParameterColumnWidth * (j - 1), DrawingPosition - ParameterRowHeight, ParameterFirstColumnWidth + ParameterColumnWidth * (j - 1) + ParameterLastColumnTextWidth, DrawingPosition - ParameterRowHeights(i))
                    TableCell.CellsSRC(visSectionObject, visRowFill, visFillPattern).FormulaU = "0"
                    TableCell.CellsSRC(visSectionObject, visRowLine, visLinePattern).FormulaU = "0"
                Else
                    Set TableCell = ParameterPage.DrawRectangle(ParameterFirstColumnWidth + ParameterColumnWidth * (j - 1), DrawingPosition - ParameterRowHeight, ParameterFirstColumnWidth + ParameterColumnWidth * j, DrawingPosition - ParameterRowHeights(i))
                End If
                TableCell.TextStyle = "Normal"
                TableCell.CellsSRC(visSectionCharacter, 0, visCharacterSize).FormulaU = "14 pt"
                TableCell.CellsSRC(visSectionParagraph, 0, visHorzAlign).FormulaU = "0"
                Select Case j
                    Case 0
                        TableCell.Text = i + 1
                    Case 1
                        TableCell.Text = Swimlanes(Conns(i).SwimlaneA)
                    Case 2
                        TableCell.Text = ElementsInSwimlane(Conns(i).SwimlaneA)(Conns(i).ElementA)
                    Case 3
                        TableCell.Text = Swimlanes(Conns(i).SwimlaneB)
                    Case 4
                        TableCell.Text = ElementsInSwimlane(Conns(i).SwimlaneB)(Conns(i).ElementB)
                    Case 5
                        TableCell.Text = ""
                        For k = 0 To Conns(i).DCNum - 1
                            If k > 0 Then TableCell.Text = TableCell.Text & vbNewLine
                            TableCell.Text = TableCell.Text & Conns(i).DataConcepts(k)
                        Next k
                    Case 6
                        TableCell.Text = ""
                        For k = 0 To Conns(i).DCNum - 1
                            If k > 0 Then TableCell.Text = TableCell.Text & vbNewLine
                            For l = 0 To Conns(i).DENum(k) - 1
                                If l > 0 Then TableCell.Text = TableCell.Text & ", "
                                TableCell.Text = TableCell.Text & Conns(i).DataElements(k, l)
                            Next l
                        Next k
                End Select
            Next j
            DrawingPosition = DrawingPosition - ParameterRowHeights(i)
        Next i
    
        'Go to the main page
        VisioApp.ActiveWindow.Page = Diagram
    End If
End Function



I feel like I know already where it is going wrong, the code only seems to be recognising certain shape types, and the terminator / start- end shape type is not one of them. Why it is doing this though is what I don't understand. I imagined appshapes would incorporate all the shapes available in Visio.

thanks for your help so far by the way!
 
You must log in or register to reply here.

Users who are viewing this thread

Total: 1 (members: 0, guests: 1)
Back
Top Bottom