Sub Main Dim Grapher As Object Set Grapher = CreateObject("Grapher.Application") Grapher.Visible = True Set Doc1 = Grapher.Documents.Active i = 1 While i < Doc1.Shapes.Count + 1 If Doc1.Shapes.Item(i).Type = grfShapeGraph Then Set Graph1 = Doc1.Shapes.Item(i) End If i = i+1 Wend 'Add legend Set Legend = Graph1.AddLegend(True) 'Link each entry to specific worksheet cell 'Loop through each plot, getting the X column i = 1 While i < Graph1.Plots.Count+1 iCol = Graph1.Plots(i).yCol 'Convert the column number to a letter iAlpha = Int((iCol-1) / 26) iRemainder = iCol - (iAlpha * 26) If iAlpha > 0 Then ConvertToLetter = Chr(iAlpha + 64) End If If iRemainder > 0 Then ConvertToLetter = ConvertToLetter & Chr(iRemainder + 64) End If 'Change the legend entry text to the right column and row Text1 = "<<@"+ConvertToLetter+"1>>" Legend.EntryName(i,Text1) i=i+1 ConvertToLetter = "" Wend 'Link legend entries to worksheet i=1 While i < Legend.EntryCount+1 Legend.EntryFont(i).worksheet = Graph1.Plots(1).worksheet i = i+1 Wend End Sub