COMadaptR.Exec

SVB Example

Generating a report from R data & output:

Sub Main

    Dim R As New COMadaptR
    R.Init

    On Error GoTo RErrorHandler
    R.Exec("score = c(97, 92, 86, 89, 90, 72, 68, 75, 64, 54)")
    R.Exec("name = c('Gabrielle', 'Suzie', 'Jo', 'Francis', 'Emma', 'Tyler', 'Mackenzie', 'Jennifer', 'Stephanie', 'Max')")
    R.Exec("df = data.frame(name, score)")

    'Retrieve our data from R and format it into a textual table for our report.
    Dim textResults As String
    'Add a formatted header for this section.
    '"\cf2" will indicate the second color from the RTF header's color table [see below],
    '"\b" will make it bold, and "\ul" will underline it.
    'Note that you must close each RTF tag with a respective "zero" tag (e.g., "\b0"),
    'following a FIFO ("first-in, first-out") stack.
    textResults = textResults & "\pard\cf2\b\ul RAW SCORES\cf0\b0\ul0\line\line "
    Dim dataOutput As Variant
    dataOutput = R.Eval("as.matrix(df)") 'Get the data as a 2D text array
    Dim i As Long, j As Long
    For i = LBound(dataOutput,1) To UBound(dataOutput,1)
        For j = LBound(dataOutput,2) To UBound(dataOutput,2)
            'Highlight failing grades in red
            '("\cf3" indicates the 3rd color in the RTF header's color table).
            If CInt(dataOutput(i,1)) < 60 Then
                textResults = textResults & "\cf3 " & dataOutput(i,j) & "\cf0 " & vbTab
            'Highlight student with 'A' grades in blue.
            ElseIf CInt(dataOutput(i,1)) >= 90 Then
                textResults = textResults & "\cf4 " & dataOutput(i,j) & "\cf0 " & vbTab
            Else
                textResults = textResults & dataOutput(i,j) & vbTab
            End If
        Next
        textResults = textResults & "\line "
    Next
    textResults = textResults & "\par "

    'Create a stem & leaf plot from R
    Dim vOutput As Variant
    vOutput = R.Eval("capture.output(try(stem(df$score), silent = TRUE))")
    'The returned stem & leaf will be an array of strings.
    'Iterate through these rows of text and put it into the report.
    textResults = textResults & "\pard\cf2\b\ul STEM & LEAF\cf0\b0\ul0\line "
    For i = LBound(vOutput) To UBound(vOutput)
        textResults = textResults & vOutput(i) & "\par "
    Next

    Dim rpt As New Report
    'Add a formatted header to the report.
    rpt.SelectionRTF = _
        "{\rtf1\ansi\ansicpg1252\deff0\deflang1029" & _
        "{\fonttbl{\f0\fnil\fprq4\fcharset0 Arial;}}" & _
        "{\colortbl ;\red0\green64\blue64;\red0\green128\blue128;\red255\green0\blue0;\red0\green0\blue200;}" & _
        "\uc1\pard\cf1\lang1033\ul\b\f0\fs22 " & _
        "Test Scores Report (" & Trim(Str(Date)) & ")\cf0\ul0\b0\par\line " & textResults & "}"
    rpt.Visible = True

    R.Close
    Exit Sub

    RErrorHandler:
    MsgBox R.GetErrorText

End Sub