Solved

Position Shapes in Visio based on External Data

Posted on 2011-03-04
3
1,695 Views
Last Modified: 2012-05-11
I have a set of coordinates (northing and easting) and data associated with each coordinate that I would like to display in visio. I would like to:
- Link the data from excel dynamically
- add a shape for each line in the spread sheet based on the data (northing, easting)
- edit the shapes based on other shape data (change the color of the shape to red based on shape data criteria)
- label the shape with the unique ID "Pile"
- have all of the data from excel as shape data that can be viewed when published or exported to PDF.

I'm new to using visio, but have been able to link the data in visio, but am not sure where to start on the other requirements.

I've attached the spread sheet I am using

 Spreadsheet-visio.xlsx
0
Comment
Question by:j_thompson
  • 2
3 Comments
 
LVL 19

Accepted Solution

by:
akoster earned 500 total points
ID: 35058859
you can start with this code and elaborate as required (fill in your specific shape(s), play with shape placement etc)

Sub export_to_visio()
Dim x As Double
Dim y As Double
Dim x_min As Double
Dim y_min As Double
Dim x_dst As Double
Dim y_dst As Double
Dim visio_app As Object
Dim visio_page As Object
Dim shape1 As Object
Dim row As Range
Dim result As Object

Const visSectionObject = 1
Const visRowFill = 3
Const visFillForegnd = 0
Const visRowXFormOut = 1
Const visXFormHeight = 3
Const visXFormWidth = 2

    '-- start visio
    Set visio_app = CreateObject("visio.application")
    visio_app.Visible = True
    
    '-- add document
    visio_app.Documents.AddEx "", visMSDefault, 0
    Set visio_page = visio_app.activepage
    
    '-- prepare shapes
    Set shape1 = visio_page.DrawRectangle(0, 0, 0, 0)
    shape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormHeight).FormulaU = "6.26 mm"
    shape1.CellsSRC(visSectionObject, visRowXFormOut, visXFormWidth).FormulaU = "22.393166287016 mm"
    
    x_min = WorksheetFunction.Min(Range("C:C"))
    y_min = WorksheetFunction.Min(Range("D:D"))
    x_dst = WorksheetFunction.Max(Range("C:C")) - x_min
    y_dst = WorksheetFunction.Max(Range("D:D")) - y_min
    
    '-- parse excel data
    For Each row In UsedRange.Rows
        
        '-- skip header row
        If row.Cells(1) <> "Pile" Then
            
            '-- set coordinates
            x = 5 * (row.Cells(3) - x_min) / x_dst
            y = 5 * (row.Cells(4) - y_min) / y_dst
                    
            '-- add shape
            Set result = visio_page.Drop(shape1, x, y)
            
            '-- add name & label
            result.name = row.Cells(1).Text
            result.Characters.begin = 0
            result.Characters.End = 0
            result.Characters.Text = row.Cells(1).Text
            
            '-- add coloring
            If row.Cells(10).Text = "YES" Then result.CellsSRC(visSectionObject, visRowFill, visFillForegnd).FormulaU = "2"
            
            '-- add custom properties
            For prop = 1 To 10
                add_property result, Cells(1, prop), row.Cells(prop)
            Next prop
       
        End If
        
    Next row
    
    '-- remove template shape
    shape1.Delete
    

    visio_app.Visible = True


End Sub

Sub add_property(shape As Object, name As String, value As String)
Const visSectionProp = 243
Const visRowLast = -2
Const visTagDefault = 0
Const visCustPropsLabel = 2
Const visCustPropsType = 5
Const visCustPropsFormat = 3
Const visCustPropsLangID = 14
Const visCustPropsCalendar = 15
Const visCustPropsPrompt = 1
Const visCustPropsValue = 0
Const visCustPropsSortKey = 4

    intPropRow = shape.addrow(visSectionProp, visRowLast, visTagDefault)
    shape.CellsSRC(visSectionProp, intPropRow, visCustPropsLabel).FormulaU = """" & name & """"
    'shape.CellsSRC(visSectionProp, intPropRow, visCustPropsType).FormulaU = "0"
    'shape.CellsSRC(visSectionProp, intPropRow, visCustPropsFormat).FormulaU = ""
    'shape.CellsSRC(visSectionProp, intPropRow, visCustPropsLangID).FormulaU = "1043"
    'shape.CellsSRC(visSectionProp, intPropRow, visCustPropsCalendar).FormulaU = ""
    'shape.CellsSRC(visSectionProp, intPropRow, visCustPropsPrompt).FormulaU = ""
    shape.CellsSRC(visSectionProp, intPropRow, visCustPropsValue).FormulaU = """" & value & """"
    'shape.CellsSRC(visSectionProp, intPropRow, visCustPropsSortKey).FormulaU = ""


End Sub

Open in new window

0
 
LVL 19

Expert Comment

by:akoster
ID: 35058882
This code is to be placed in the 'horizontal' worksheet and takes a couple of minutes to complete
0
 

Author Closing Comment

by:j_thompson
ID: 35059245
Wow!! that is perfect! thanks so much!!!
0

Featured Post

Why You Should Analyze Threat Actor TTPs

After years of analyzing threat actor behavior, it’s become clear that at any given time there are specific tactics, techniques, and procedures (TTPs) that are particularly prevalent. By analyzing and understanding these TTPs, you can dramatically enhance your security program.

Join & Write a Comment

Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

746 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now