Sparklines/Microcharts - howto name and group lines

[ronnyfo]

Hia all
I am trying to make sparklines/microcharts and run into a problem..
How do i name the lines? (and group them afterwards?)

Here is my code:
-----------------------
Sub sparkline()

limit = 30


'Fill Range with random numbers
For Row = 1 To limit
Cells(Row, 10) = Rnd(100) * 100
Next Row

Set myDocument = Worksheets(1)
Range("C10").Select
cell_xpos = ActiveCell.Left
cell_ypos = ActiveCell.Top
cell_width = ActiveCell.Width
cell_height = ActiveCell.Height

xstep = cell_width / limit
ystep = (cell_height / 100)

x1 = cell_xpos
y1 = cell_ypos + cell_height
y_Start = cell_ypos + cell_height

For Row = 1 To limit
Cells(Row, 10).Select
Change = Cells(Row, 10).Value
x2 = x1 + xstep
y2 = y_Start - (ystep * Change)

With myDocument.Shapes.AddLine(x1, y1, x2, y2)

.Line.Weight = 0.5
.Line.ForeColor.RGB = RGB(50, 0, 128)
.ZOrder msoSendToBack
' .name="sparkline" & row '**** this doesn't work
' .Line.name="sparkline & row ' ** nor this


End With

x1 = x2
y1 = y2

Next Row
Range("A1").Select


End Sub

 

[pbornemeier]

I added this code at the start to delete any existing shapes:

'Delete existing shapes
For iLimit = ActiveSheet.Shapes.Count To 1 Step -1
    ActiveSheet.Shapes(iLimit).Delete
Next

And then had no problem running the code when I uncommented this line:

.Name = "sparkline" & Row '**** this doesn't work

Without the deletion code, the second time the code is run, it is trying to name the line it just drew with a name it already used the previous run, which generated a Run-time error 70: Permission denied

Perhaps you should incorporate the address of the cell that contains each line of the sparkline into the name of each line in the sparkline.

.Name = "sparkline" & "_" & ActiveCell.Address & "_" & Row

 

[ronnyfo]

Excellent!
I tinkered a bit more with it and was annoyed that I wasn't able to make one line (one shape) out of the linesegment, and instead had a go at making a polyline instead, which works rather nicely..

But if you know how to put the linesegments together to one line, please do tell!

Sub sparkline()
Dim polyArray(1 To 31, 1 To 2) As Single

limit = 30


'Fill Range with random numbers
For Row = 1 To limit
Cells(Row, 10) = Rnd(100) * 100
Next Row


'Getting the startposition
Set myDocument = Worksheets(1)
Range("C10").Select
cell_xpos = ActiveCell.Left
cell_ypos = ActiveCell.Top
cell_width = ActiveCell.Width
cell_height = ActiveCell.Height

'Calculate the steps
xstep = cell_width / limit
ystep = (cell_height / 100)

'Calculate the coordinates
x = cell_xpos
y = cell_ypos + cell_height
y_Start = cell_ypos + cell_height

'Making the coordinate-array
For Row = 1 To limit + 1
    Cells(Row, 10).Select
    Change = Cells(Row, 10).Value
    polyArray(Row, 1) = x
    polyArray(Row, 2) = y
    
   x = x + xstep
   y = y_Start - (ystep * Change)
Next Row

'Drawing the polyline
 With myDocument.Shapes.AddPolyline(polyArray)
 .Line.Weight = 0.5
 .Line.ForeColor.RGB = RGB(50, 0, 128)
 .ZOrder msoSendToBack
 .Name = "sparkline" & "_" & ActiveCell.Address & "_" & Row
 End With
 
       
Range("A1").Select


End Sub

 

[pbornemeier]

But if you know how to put the linesegments together to one line, please do tell!

Found a way:

Function ShapeGroup(sStartOfShapeName As String)
'Based on code from
'http://www.mrexcel.com/forum/showthread.php?t=382356
    Dim shp As Shape
    Dim iX As Integer
    Dim aShapes() As Variant
    On Error Resume Next
    ActiveSheet.Shapes(sStartOfShapeName).Delete
    On Error GoTo 0
 
    iX = 0
    For Each shp In ActiveSheet.Shapes
        If Left(shp.Name, Len(sStartOfShapeName)) = sStartOfShapeName Then
            ReDim Preserve aShapes(iX)
            aShapes(iX) = shp.Name
            iX = iX + 1
        End If
    Next shp
    ActiveSheet.Shapes.Range(aShapes).Select
    Selection.ShapeRange.Group.Select
    Selection.Name = sStartOfShapeName
 
End Function

Even a blind pig finds an acorn once in a while.