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
Be the first to write a comment.