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