EXCEL :: VBA :: Barre de progression via un graphique cylindrique

[oguruma]

Bonsoir, une petite contribution rapide sur la création d'une barre de progression via un graphique sous forme de cylindre pour obtenir un exemple comme celui-ci

Pendant les traitements la coloration de la zone transparente est progressive comme ci-dessous

Cette jauge repose en fait sur un graphique dans un onglet de paramétrage

Le calcul de la transparence est effectué dans la cellule en C2

Les séries de données sont les suivantes

Je vous laisse voir les détails dans le fichier joint.
C'est de la conception graphique classique et ce n'est pas l'objet de ce post.

En fait il est donc possible de créer le graphique comme bon vous semble au niveau du Design.
Ce graphique est en fait dupliqué dans la feuille dans laquelle on souhaite afficher la barre de progression.
Certes on aurait pu le créer dynamiquement dans la feuille destination mais autant faire simple et s'appuyer sur un graphique déjà créé et le recopier pour l'afficher.

Pour cela une procédure de chargement

Function LOAD_GRAPH_PROGRESS_BAR(hDestWks As String, hAddress As String, _
Optional hGraph As String = "BAR_GRAPHIC", Optional hSourceWks As String = "PARAM_BAR") As Variant
 
    Dim oGraphBarChart As ChartObject
    Dim oGraphBarChartArea As ChartArea
   
    Set LOAD_GRAPH_PROGRESS_BAR = Nothing
   
    On Error GoTo HANDLE_ERROR
   
    Set oGraphBarChart = ActiveWorkbook.Worksheets(hSourceWks).ChartObjects(hGraph)
    oGraphBarChart.Activate
   
    Set oGraphBarChartArea = ActiveChart.ChartArea
   
    oGraphBarChartArea.Copy

    ActiveWorkbook.Worksheets(hDestWks).Activate
    Range(hAddress).Activate
    ActiveSheet.Paste

    Range("A1").Activate
   
    Set LOAD_GRAPH_PROGRESS_BAR = oGraphBarChart
   
FIN:
    Set oGraphBarChart = Nothing
    Set oGraphBarChartArea = Nothing
    Exit Function

HANDLE_ERROR:
    Resume FIN

End Function

et en fin de traitement il est donc nécessaire de supprimer le graphique de la feuille destination via le code suivant

Function UNLOAD_GRAPH_PROGRESS_BAR(Optional hGraph As String = "BAR_GRAPHIC", Optional hDestWks As String = "ActiveSheet") As Boolean
 
    Dim oGraphBarChart As ChartObject
    Dim wk As Worksheet
   
    UNLOAD_GRAPH_PROGRESS_BAR = False
   
    On Error GoTo HANDLE_ERROR
   
    If hDestWks = "ActiveSheet" Then Set wk = ActiveSheet Else Set wk = ActiveWorkbook.Worksheets(hDestWks)
   
    Set oGraphBarChart = wk.ChartObjects(hGraph)
    oGraphBarChart.Activate
   
    oGraphBarChart.Delete
   
    UNLOAD_GRAPH_PROGRESS_BAR = True
   
FIN:
    Set oGraphBarChart = Nothing
    Exit Function

HANDLE_ERROR:
    Resume FIN

End Function

Un exemple pour tester tout ceci

Sub TEST_PROGRESS_BAR()
    Dim oGraphBarChart As ChartObject
    Dim lngIdx As Long
   
    Set oGraphBarChart = LOAD_GRAPH_PROGRESS_BAR("Feuil2", "E5")
    If oGraphBarChart Is Nothing Then
        MsgBox "Impossible de charger la barre de progression"
        Exit Sub
    Else
        Debug.Print oGraphBarChart.Name
    End If
   
    Range("GRAPH_KPI") = 0
 
    For lngIdx = 0 To 300
        '
        ' ==> ici vos traitements...
        '
        Range("MSG_TITRE") = "Traitement " & CStr(lngIdx)
   '     Range("COMPLEMENT_TRSP_INFO") = "Complément " & CStr(lngIdx)
        Range("GRAPH_X_LIBELLE") = "Traitement " & CStr(lngIdx)
        Range("GRAPH_KPI") = lngIdx / 300
        oGraphBarChart.Chart.Refresh ' on refresh par sécurité après
        DoEvents
    Next

    MsgBox "Traitements terminés"

    Range("GRAPH_KPI") = 0
    Range("MSG_TITRE") = "<DEFAUT>"
    Range("COMPLEMENT_TRSP_INFO") = "<DEFAUT>"
    Range("GRAPH_X_LIBELLE") = "<DEFAUT>"
   
    If Not UNLOAD_GRAPH_PROGRESS_BAR() Then
        MsgBox "Impossible de supprimer la barre de progression"
    End If
   
FIN:
    Exit Sub
   
HANDLE_ERROR:
    MsgBox "incident n° " & Err.Number & " - " & Err.Description
    Resume FIN
End Sub

Via les deux lignes de code ci-dessous pour commenter les traitements en cours en utilisant le titre du graphique et l'axe X via cet exemple

        Range("MSG_TITRE") = "Traitement " & CStr(lngIdx)
        Range("GRAPH_X_LIBELLE") = "Traitement " & CStr(lngIdx)

Ces deux champs nommés sont attachés au titre et l'axe X.

Voilà c'est certainement rudimentaire et perfectible mais ça fait job ! 🙂