Add a legend to a graph where the legend entries are the X column headers in Grapher automation

This article contains a sample script for adding a legend to a graph in an existing Grapher plot, where each legend entry is tied to the plot's X column header.

To run this script:

  1. Click here to download the BAS file: NameLegendwithCells.BAS.
  2. Click Automation | Scripts | Run, select the BAS file from your downloads directory, and click Open.

OR:

  1. Copy the script below.
  2. Open Grapher and turn on the Script Manager by clicking View | Display | Script Manager.
  3. Press Ctrl+A to select all of the existing lines in the Script Manager and then press DELETE.
  4. Press Ctrl+V to paste it into the Script Manager.
  5. Click the Start/Resume icon () in the Script Manager.
Sub Main
    On Error Resume Next
    
    ' Initialize Grapher application
    Dim Grapher As Object
    Set Grapher = CreateObject("Grapher.Application")
    Grapher.Visible = True
    
    ' Get active document
    Dim Doc As Object
    Set Doc = Grapher.Documents.Active
    If Doc Is Nothing Then
        MsgBox "No active document found"
        Exit Sub
    End If
    
    ' Find the graph shape
    Dim Graph As Object
    Set Graph = FindGraphShape(Doc)
    If Graph Is Nothing Then
        MsgBox "No graph found in the document"
        Exit Sub
    End If
    
    ' Add legend and link to worksheet cells
    Call AddAndConfigureLegend(Graph)
    
    MsgBox "Legend configuration completed successfully"
End Sub

' Function to find the first graph shape in the document
Function FindGraphShape(Doc As Object)
    Dim i As Integer
    Set FindGraphShape = Nothing
    
    For i = 1 To Doc.Shapes.Count
        If Doc.Shapes.Item(i).Type = grfShapeGraph Then
            Set FindGraphShape = Doc.Shapes.Item(i)
            Exit Function
        End If
    Next i
End Function

' Subroutine to add legend and configure entries
Sub AddAndConfigureLegend(Graph As Object)
    Dim Legend As Object
    Dim i As Integer
    Dim iCol As Integer
    Dim colLetter As String
    Dim legendText As String
    Dim worksheet As Object
    
    ' Add legend to graph
    Set Legend = Graph.AddLegend(True)
    
    ' Check if graph has plots
    If Graph.Plots.Count = 0 Then
        MsgBox "No plots found in the graph"
        Exit Sub
    End If
    
    ' Store worksheet reference from first plot
    wksPath = Graph.Plots(1).worksheet
    
    ' Loop through each plot and configure legend entries
    For i = 1 To Graph.Plots.Count
        ' Get Y column for the current plot
        iCol = Graph.Plots(i).yCol
        
        ' Convert column number to Excel-style letter
        colLetter = ConvertColumnToLetter(iCol)
        
        ' Set legend entry text to reference cell in row 1
        legendText = "<<@" & colLetter & "1>>"
        Legend.EntryName i, legendText
        
        ' Link legend entry font to worksheet
        Legend.EntryFont(i).worksheet = wksPath
    Next i
End Sub

' Function to convert column number to Excel-style letter (A, B, ..., Z, AA, AB, ...)
Function ConvertColumnToLetter(colNum As Integer) As String
    Dim result As String
    Dim quotient As Integer
    Dim remainder As Integer
    
    result = ""
    
    Do While colNum > 0
        remainder = (colNum - 1) Mod 26
        result = Chr(65 + remainder) & result
        colNum = Int((colNum - remainder) / 26)
    Loop
    
    ConvertColumnToLetter = result
End Function

 

Was this article helpful?
...

Comments

0 comments

Please sign in to leave a comment.