Sparklines/Microcharts - howto name and group lines

ronnyfo

New Member
Joined
Jun 26, 2007
Messages
18
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
 

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
I added this code at the start to delete any existing shapes:
Code:
'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:
Code:
.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.
Code:
.Name = "sparkline" & "_" & ActiveCell.Address & "_" & Row
 
Last edited:
Upvote 0
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! :)


Code:
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
 
Upvote 0
But if you know how to put the linesegments together to one line, please do tell! :)

Found a way:
Code:
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. :biggrin:
 
Upvote 0

Forum statistics

Threads
1,213,546
Messages
6,114,256
Members
448,557
Latest member
richa mishra

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top