Convert Excel VBA to work in Access for Chart

[tennisbuck]

Hi Everyone,

Does anybody know if its feasible to convert excel VBA so it will run in access? The excel VBA produces box plot graphs and I'm not even sure if Access can handle it. With the help of June 7, I have the variable Min, Max, 1st quartile, etc all created in a query.

Here's the code:

Sub main()
Dim mystr As String
' coded by sukhbinder
' date: 12 Jan 2011

' Get the range of values from user
Set inrange = Application.InputBox( _
prompt:="Select a cell", Type:=8, Default:=Selection.Address)
If inrange Is Nothing Then End


' Find no of rows and column in data selected
ro = inrange.Rows.Count
co = inrange.Columns.Count


srow = ro + 2
endrow = ro
scol = 1
endcol = scol + co


Application.ScreenUpdating = False


' Calculate the basic statistic to draw the boxplot
Call writevals(srow, endrow, scol, endcol)


' Insert a Plot and format to show as a boxplot
a = 1
mystr = Range(Cells(srow, scol), Cells(srow + 5, endcol)).Address
s = Boxtest(mystr)
Application.ScreenUpdating = True


End Sub


Sub writevals(rr, rrend, cc, endcol)
Dim group As String
Dim srng As Range
Dim kkr As Integer
Dim kkc As Integer


Cells(rr, cc) = "Statistic"
Cells(rr + 1, cc) = "Q1"
Cells(rr + 2, cc) = "Min"
Cells(rr + 3, cc) = "Median"
Cells(rr + 4, cc) = "Max"
Cells(rr + 5, cc) = "Q3"


kkr = rr - rrend - 1
kks = rrend


' For each column calculate the stats
For i = cc + 1 To endcol


group = "Group " & Trim(Str(i - 1))
Cells(rr, i) = Trim(group)
Set srng = Range(Cells(kks, i - 1), Cells(kkr, i - 1))
Cells(rr + 1, i) = "=ROUND(QUARTILE(" & srng.Address & ",1),4)"
Cells(rr + 2, i) = "=ROUND(MIN(" & srng.Address & "),4)"
Cells(rr + 3, i) = "=ROUND(QUARTILE(" & srng.Address & ",2),4)"
Cells(rr + 4, i) = "=ROUND(MAX(" & srng.Address & "),4)"
Cells(rr + 5, i) = "=ROUND(QUARTILE(" & srng.Address & ",3),4)"
Next i


End Sub
Function Boxtest(mystr As String)
' This routine inserts a plot and actually formats it as a box plot
' coded by sukhbinder
' date: 12 Jan 2011
shname = ActiveSheet.Name
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Sheets(shname).Range(mystr), PlotBy _
:=xlRows
ActiveChart.Location Where:=xlLocationAsObject, Name:=shname
With ActiveChart
.HasTitle = False
.Axes(xlCategory, xlPrimary).HasTitle = False
.Axes(xlValue, xlPrimary).HasTitle = False
End With


icount = ActiveChart.SeriesCollection.Count

For i = 1 To icount
ActiveChart.SeriesCollection(i).Select
With Selection.Border
.Weight = xlThin
.LineStyle = xlNone
End With
With Selection
.MarkerBackgroundColorIndex = xlNone
.MarkerForegroundColorIndex = xlAutomatic
.MarkerStyle = xlAutomatic
.Smooth = False
.MarkerSize = 5
.Shadow = False
End With
Next i

ActiveChart.PlotArea.Select
Selection.ClearFormats
ActiveChart.Axes(xlValue).MajorGridlines.Select
Selection.Delete

ActiveChart.SeriesCollection(1).Select
With ActiveChart.ChartGroups(1)
.HasDropLines = False
.HasHiLoLines = True
.HasUpDownBars = True
.GapWidth = 150
End With
test = 1
End Function

[June7]

I would be interested in seeing the Excel workbook if you want to provide.

On report I created xyScatter chart with RowSource:
SELECT [Marketing View Description], [Lowest], [25th], [50th], [75th], [Highest] FROM [Test 2] GROUP BY [Marketing View Description], [Lowest], [25th], [50th], [75th], [Highest];

Then I tried code in report Detail Format procedure:

Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer)
 ' This routine inserts a plot and actually formats it as a box plot
 ' coded by sukhbinder
 ' date: 12 Jan 2011

With Me.Graph0
    .ChartType = xlLineMarkers
    .HasTitle = False
    .Axes(xlCategory, xlPrimary).HasTitle = False
    .Axes(xlValue, xlPrimary).HasTitle = False
    
    icount = .SeriesCollection.Count
    
    For i = 1 To icount
        With .SeriesCollection(i)
        .Border.Weight = xlThin
        .Border.LineStyle = xlNone
        .MarkerBackgroundColorIndex = xlNone
        .MarkerForegroundColorIndex = xlAutomatic
        .MarkerStyle = xlAutomatic
        .Smooth = False
        .MarkerSize = 5
        .Shadow = False
        End With
    Next i
    
    With .PlotArea
    .ClearFormats
    '.Axes(xlValue).MajorGridlines
    '.Delete
    End With
    
    With .SeriesCollection(1)
    '.ChartGroups (1)
    '.HasDropLines = False
    '.HasHiLoLines = True
    '.HasUpDownBars = True
    '.GapWidth = 150
    End With
End With

End Sub

It first bombs on the .Axes(xlValue).MajorGridlines line with 'does not support' and everything that follow errors so I commented out what doesn't error. What's left doesn't really seem to do anything.

[tennisbuck]

My pleasure. Here's the workbook with random data. The only think I don't like about it doesn't include the group name.

[June7]

I did some more edits on my previous post.

[tennisbuck]

At least we tried!