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
 

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,711
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:

ronnyfo

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

pbornemeier

Well-known Member
Joined
May 24, 2005
Messages
3,711
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:
 

Forum statistics

Threads
1,081,728
Messages
5,360,920
Members
400,602
Latest member
newaqua

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top