Calling R from Excel

Nowadays, there are multiple choices of programming languages. They are nested in one project as is often the case. I once wrote a post about calling C++ from R. Today, I’d like to share a quick way to call R program from Excel (with a few lines of VBA code), which I believe would be useful in many cases.

Background

For background, I was asked to model the competitive rate (“taux concurrentiel”, ou “taux servi moyen” in French) for life savings insurance products. The model had to depend on a historic of interest rates and their moving averages. The first step was to study the correlation of these rates and to figure out which of them are really useful for explaining the competitive rate. The second step was to choose a method to analyse quantitative datas: Principal Component Analysis (PCA) technique was chosen for the task. I didn’t want to implement the PCA from scratch with Excel and VBA. So, I turned to the FactoMineR package in R for help (of course). The rest of the project needed to be done in Excel.

Main steps

Here is the idea and the main steps:

0) Some preliminary works need to be done in the main Excel file for input preparation.

1) An input csv file is then built and saved (with VBA code) in the input folder.

2) Then, I use VBA to call R portable (just a lighter version of R, you can use R instead) and run my R script which is in charge of the PCA analysis. For this step, you need to specify (in the Excel file) where to find R portable and your R script. We also assume that the FactoMineR package has been installed.

3) The output (some graphs built with R) will be saved in the output folder at the end of the R script run.

4) Finally, the VBA code will copy all these graphs and paste them back into the main Excel file.

image

R script

rm(list=ls())

ARGS = commandArgs(TRUE)    
Chemin_inputs_csv = toString(ARGS[1])
Chemin_outputs_csv = toString(ARGS[2])

#input folder
setwd(Chemin_inputs_csv)

data<-read.table(file="input.csv", sep=";", header=TRUE, row.names=1, check.names=FALSE, dec = ",")

# install.packages("FactoMineR")
library(FactoMineR)

# PCA
pca<-PCA(data)

# output folder
setwd(Chemin_outputs_csv)

do.call(file.remove, list(list.files(Chemin_outputs_csv, full.names = TRUE)))

#plots
jpeg('graphe_eboulis_vp.jpg')
plot(1:length(pca$eig$eigenvalue), pca$eig$eigenvalue, type="b", ylab="Valeur propre", xlab="Composante p", main="Scree plot")
dev.off()

jpeg('graphe_variance_cumulee.jpg')
plot(1:length(pca$eig$"cumulative percentage of variance"), pca$eig$"cumulative percentage of variance", type="b", ylab="% de la variance expliqué", xlab="Composante p", main="Graphique des % cumulés")
dev.off()

jpeg('graphe_acp_ind.jpg')
plot.PCA(pca, axes=c(1, 2), choix="ind", habillage="ind")
dev.off()

jpeg('graphe_acp_var.jpg')
plot.PCA(pca, axes=c(1, 2), choix="var", habillage="none")
dev.off()

dimen= dimdesc(pca, axes=c(1,2))
write.csv2(dimen$Dim.1$quanti, "axe1.csv")
write.csv2(dimen$Dim.2$quanti, "axe2.csv")

write.infile(pca, file="pca_result.txt", sep="\t")

VBA

Declare Function OpenProcess Lib "kernel32" (ByVal Access As Long, ByVal Handle As Long, ByVal Process As Long) As Long
Declare Function GetExitCodeProcess Lib "kernel32" (ByVal Process As Long, ExitCode As Long) As Long


Public Const AccessType As Long = &H400
Public Const StillActive As Long = &H103

Sub test()

    Dim oshell As Object
    Set oshell = VBA.CreateObject("WScript.Shell")
    Set oEnv = oshell.Environment("PROCESS")

    Dim waitTillComplete As Boolean: waitTillComplete = True
    Dim style As Integer: style = 1
    Dim errorCode As Integer
    Dim path As String

    adresseR = VBA.Chr(34) & Replace(Cells.Range("RhomeDir"), "/", "\") & VBA.Chr(34)
    adresseProg = VBA.Chr(34) & Replace(Cells.Range("MyRscript"), "/", "\") & VBA.Chr(34)
    adresseInp = VBA.Chr(34) & Replace(Cells.Range("Input_path"), "/", "\") & VBA.Chr(34)
    adresseOuT = VBA.Chr(34) & Replace(Cells.Range("Output_path"), "/", "\") & VBA.Chr(34)


    path = adresseR & " " & adresseProg & " " & adresseInp & " " & adresseOuT

    ' désactiver l'avertissement de sécurité
    oEnv("SEE_MASK_NOZONECHECKS") = 1
    ' lancer le script R avec shell
    errorCode = oshell.Run(path, style, waitTillComplete)
    oEnv.Remove ("SEE_MASK_NOZONECHECKS")


    ' Ne pas exécuter la macro VBA tant que l'exécution du code R n'est pas terminée
    Proc = OpenProcess(AccessType, False, ProcessShell)
    Do
        GetExitCodeProcess Proc, ExitCode
        DoEvents
    Loop While ExitCode = StillActive

    ' message
    If errorCode = 0 Then
        MsgBox "L'ACP a été réalisée avec succès sous R. Vous pouvez retrouver l'ensemble des outputs dans " & adresseOuT
    Else
        MsgBox "Le programme n'a pas pu être tourné suite à l'erreur " & errorCode & "."
    End If

    'supprimer toutes les images présentes dans l'onglet
    For Each pic In ActiveSheet.Pictures
        pic.Delete
    Next pic
    'recopier les images issus du programme R dang l'onglet Excel
    Call load_image("graphe_eboulis_vp.jpg", Range("A12"))
    Call load_image("graphe_variance_cumulee.jpg", Range("G12"))
    Call load_image("graphe_acp_ind.jpg", Range("A42"))
    Call load_image("graphe_acp_var.jpg", Range("G42"))
End Sub

Sub load_image(namePic As String, position As Range)

    position.Select
    Dim sFile As String

    sFile = Range("Output_path") & "\" & namePic

    ActiveSheet.Pictures.Insert(sFile).Select
        Selection.ShapeRange.Height = 324
        Selection.ShapeRange.Width = 396
    With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.ObjectThemeColor = msoThemeColorText1
        .ForeColor.TintAndShade = 0
        .ForeColor.Brightness = 0
        .Transparency = 0
    End With
End Sub

You can take a look at the project skeleton here. (The input csv file is assumed to be already available in the input folder).

Voilà!!!

comments powered by Disqus