Building Plots in Visio

I like to automate Microsoft Visio to draw plots. They look so much more professional and I don’t have to fuss with Excel to figure out how to make plots look like I want. Again, this is me practicing my theory of being in control, not letting software control us. Please let me know if this code is useful.

This is my source code for the stacked bar plot I’m working on. Built as an excel Macro, it automates Visio to build the plot.


Sub BuildPlot()

Dim oApp As Excel.Application
Dim oWB As Excel.Workbook

Dim oDoc As Visio.Document
Dim oPage As Visio.Page
Dim oShape As Visio.Shape

Set oApp = New Excel.Application
Set oWB = oApp.Workbooks.Open("c:usersTimothy.BooherDesktopbar_plot_macro.xlsx")

Set oDoc = Application.ActiveDocument
Set oPage = Application.ActivePage

Dim iRow As Integer
Dim iAircraft As Integer
Dim x As Double
Dim x_prime As Double
Dim y As Double
Dim y_prime As Double
Dim xWidth As Double
Dim xGap As Double
Dim iStart As Integer

xWidth = 0.5
xGap = 2
x = 0
iStart = 2

For iAircraft = iStart To (iStart + 4)
    Debug.Print oWB.sheets(1).Cells(iAircraft, 2).Value
    x = x + xGap
    x_prime = x + xWidth
    y_prime = 0
    For iRow = 7 To 4 Step -1
        Debug.Print oWB.sheets(1).Cells(iAircraft, iRow).Value
        If oWB.sheets(1).Cells(iAircraft, iRow).Value > 0 Then
            y = y_prime
            y_prime = y + oWB.sheets(1).Cells(iAircraft, iRow).Value * 0.8
            Set oShape = oPage.DrawRectangle(x, y, x_prime, y_prime)
            oShape.Cells("FillForegnd") = 8 - iRow
        End If
    Next iRow
Next iAircraft

oWB.Close

Set oApp = Nothing

End Sub

Sub draw_axes()

Dim oDoc As Visio.Document
Dim oPage As Visio.Page
Dim oShape As Visio.Shape

Set oDoc = Application.ActiveDocument
Set oPage = Application.ActivePage

Dim i As Integer ' y
Dim j As Integer ' x

Dim numX  As Integer
Dim numY As Integer
Dim max_val As Double
Dim y_new As Double

numX = 10
numY = 10

max_val = 15 ' Ceiling(14.65)

' draw y axis
oPage.DrawLine 0, 0, 0, max_val

y_new = 0

For i = 1 To numY + 1
 'DrawLine
 oPage.DrawLine 0, y_new, 0.1, y_new
 y_new = y_new + max_val / numY
Next i

' draw x
'For j = 1 To numX
'
'Next j


End Sub

Sub build_conf_intervals()
    
Dim oDoc As Visio.Document
Dim oPage As Visio.Page
Dim oShape As Visio.Shape

Set oDoc = Application.ActiveDocument
Set oPage = Application.ActivePage

Dim iAircraft As Integer
Dim iBar As Integer

Dim y(1) As Double
delta_x = 3
to_wit = 0.1

x = 0

For iAircraft = 16 To 20
    x = x + delta_x
    For iBar = 2 To 3
        y(iBar - 2) = oWB.sheets(1).Cells(iAircraft, iBar).Value
    Next iBar
    oPage.DrawLine x, y(0), x, y(1)
    oPage.DrawLine x - to_wit, y(1), x, y(1)
    oPage.DrawLine x - to_wit, y(0), x, y(0)
Next iAircraft

oWB.sheets(1).Cells(iAircraft, 2).Value

End Sub

Leave a Reply