# Maybe overflow somewhere ... or what else ?

• ### Question

• I 've made this code for generating a timeline.

I made it pretty flexible I think, but have some issues when "going big".

Test it this way:

Copy the code to a module in Excel

Have an empty Worksheet - maybe turn off rows, columns an cells

Call the sub from the immidiate window like this:

timeLine 1950,2018

then you'll have a nice arrowhead to the right of the timeline.

Clear the worksheet by calling:

deleteAllShapes

Then change the call to:

timeLine 1950,2019

Now there is NO ARROWHEAD fare out to the right !!!

Is there some overflow somewhere "down the line" or what else could be wrong ?

```Public Sub timeLine(startYear As Integer, endYear As Integer)
Const topSpace As Long = 50
Const leftSpace As Long = 200
Const yearSpace As Long = 215    ' >= 39
Const stickOut As Long = 20
Const yearBoxWidth As Long = 38
Dim arrow As Shape, yearBox As Shape, x As Long, subDivider As Shape, subX As Long
If startYear <= endYear Then
' first draw the timeline as an arrow with a calculated length
Set arrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace - stickOut, topSpace, _
leftSpace + (endYear - startYear + 1) * yearSpace + 1.8 * stickOut, topSpace)
With arrow
.Line.ForeColor.RGB = ColorConstants.vbBlue
.Name = "Timeline"
End With
Set arrow = Nothing
' then insert the years and some subdividers
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace, topSpace - 10, leftSpace, topSpace)
Set subDivider = Nothing
For x = 1 To endYear - startYear + 1                                      '   1 extra for moving the "textbox" a little to the right when yearSpace is small
Set yearBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 1 + leftSpace + (x - 1) * yearSpace + yearSpace / 2 - yearBoxWidth / 2, _
topSpace - 25, yearBoxWidth, 20)
subX = leftSpace + x * yearSpace
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, subX, topSpace - 10, subX, topSpace)
subDivider.Line.ForeColor.RGB = ColorConstants.vbBlue
With yearBox
.TextFrame.Characters.Text = startYear - 1 + x
.Line.Visible = msoFalse
End With
Set yearBox = Nothing
Set subDivider = Nothing
Next x
End If
End SubPublic Sub deleteAllShapes()    ActiveSheet.DrawingObjects.DeleteEnd Sub```

Saturday, March 24, 2018 11:50 PM

• Hi Ksor2,

You had mentioned that,"Furthe more the arrowhead sometimes disappears and comes up again if you zoom - Ctrl+mousewheel !"

I try to make a test on my side and I got the same result like you.

I try to modify the part below to correct the issue.

Old Code:

``` With arrow
.Line.ForeColor.RGB = ColorConstants.vbBlue
End With```

New Code:

``` With arrow
.Line.ForeColor.RGB = ColorConstants.vbBlue
.Name = "Timeline"
End With```

Output:

Other thing you had mentioned that,"The FIRST subdivider to the left doesn't get the color - how to change that ?"

I check the first left subdivider. i find that it has blue color.

Did I misunderstand anything? If yes, Try to correct me. I will try to provide further suggestions to solve the issue.

Regards

Deepak

MSDN Community Support
Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

• Marked as answer by Monday, March 26, 2018 9:36 AM
Monday, March 26, 2018 7:34 AM

### All replies

• Hi Ksor2,

I've been impressed by your work.

code related with green [TimeLine] button:
(some values are modified for screenshot: stopping TimeLine from being too wide)
```' ---[Time Line] button
Private Sub btn_Timeline_Click()
Call prc_DeleteAllShapes
Call prc_TimeLine(Range("B1").Value, Range("B2").Value)
End Sub
' ----------------------------------
Public Sub prc_TimeLine(startYear As Integer, endYear As Integer)
Const topSpace As Long = 100
Const leftSpace As Long = 30
Const yearSpace As Long = 50    ' >= 39
Const stickOut As Long = 20
Const yearBoxWidth As Long = 38
Dim arrow As Shape, yearBox As Shape, x As Long, subDivider As Shape, subX As Long
' ---
If (startYear <= endYear) Then
' first draw the timeline as an arrow with a calculated length
(msoConnectorStraight, leftSpace - stickOut, topSpace, _
leftSpace + (endYear - startYear + 1) * yearSpace + 1.8 * stickOut, topSpace)
With arrow
.Line.ForeColor.RGB = ColorConstants.vbBlue
.Name = "Timeline"
End With
Set arrow = Nothing
' then insert the years and some subdividers
(msoConnectorStraight, leftSpace, topSpace - 10, leftSpace, topSpace)
Set subDivider = Nothing
For x = 1 To endYear - startYear + 1   '  -- 1 extra for moving the "textbox" a little to the right when yearSpace is small
(msoTextOrientationHorizontal, _
1 + leftSpace + (x - 1) * yearSpace + yearSpace / 2 - yearBoxWidth / 2, _
topSpace - 25, yearBoxWidth, 20)
subX = leftSpace + x * yearSpace
(msoConnectorStraight, subX, topSpace - 10, subX, topSpace)
subDivider.Line.ForeColor.RGB = ColorConstants.vbBlue
With yearBox
.TextFrame.Characters.Text = startYear - 1 + x
.Line.Visible = msoFalse
End With
Set yearBox = Nothing
Set subDivider = Nothing
Next x
End If
End Sub
' ------------------------------------
Public Sub prc_DeleteAllShapes()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
If (shp.Type <> 12) Then
shp.Delete  ' -- Type:12 = Button
End If
Next
End Sub
```
code in red [Show Shapes] button:
(this code is for checking what kind of shapes in worksheet)
```' ---[Show Shapes] button
Private Sub btn_ShowShapes_Click()
Dim myRow As Integer: myRow = 2
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
Cells(myRow, 5).Value = shp.Type
Cells(myRow, 6).Value = shp.Name
myRow = myRow + 1
Next
End Sub```

Regards,

Ashidacchi -- http://hokusosha.com/

P.S.
If you want to make width of TimeLine limited,
(1) set max-width to some value/width
(2) divide max-width by time span (the number of years between startYear and endYear) and set the result to YearSpace.
• Edited by Sunday, March 25, 2018 3:42 AM
Sunday, March 25, 2018 3:34 AM
• Thx - but how about my question ... the arrowhead ... what's going on when it's NOT there ?

Your code didn't solve that problem !

EDIT: You misunderstood my comment on the "1 extra" - it a comment on this "1":

```            Set yearBox = ActiveSheet.Shapes.AddTextbox _
(msoTextOrientationHorizontal, _
here >>>> 1 + leftSpace + (x - 1) * yearSpace + yearSpace / 2 - yearBoxWidth / 2, _
topSpace - 25, yearBoxWidth, 20)```

• Edited by Sunday, March 25, 2018 9:20 AM
Sunday, March 25, 2018 8:01 AM
• Furthe more the arrowhead sometimes disappears and comes up again if you zoom - Ctrl+mousewheel !

What is this mess all about ?

Sunday, March 25, 2018 9:31 AM
• The FIRST subdivider to the left doesn't get the color - how to change that ?
Sunday, March 25, 2018 9:52 AM
• Hi Ksor2,

Don't get angry, calm down please.
Please provide your requirement more concrete (as a whole, not separate them into several posts) . I'm not good at English, so, I am confused.

Regards,

Ashidacchi -- http://hokusosha.com/

Sunday, March 25, 2018 10:32 AM
• Ha, ha, who's angry here ... I'm not ... look here ;-)) !

Oh, I forgot ... you don't have the version where the color of the arrow and the subdividers is given a color - sorry !
• Edited by Sunday, March 25, 2018 11:06 AM
Sunday, March 25, 2018 11:04 AM
• Hi Ksor2,

You had mentioned that,"Furthe more the arrowhead sometimes disappears and comes up again if you zoom - Ctrl+mousewheel !"

I try to make a test on my side and I got the same result like you.

I try to modify the part below to correct the issue.

Old Code:

``` With arrow
.Line.ForeColor.RGB = ColorConstants.vbBlue
End With```

New Code:

``` With arrow
.Line.ForeColor.RGB = ColorConstants.vbBlue
.Name = "Timeline"
End With```

Output:

Other thing you had mentioned that,"The FIRST subdivider to the left doesn't get the color - how to change that ?"

I check the first left subdivider. i find that it has blue color.

Did I misunderstand anything? If yes, Try to correct me. I will try to provide further suggestions to solve the issue.

Regards

Deepak

MSDN Community Support
Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

• Marked as answer by Monday, March 26, 2018 9:36 AM
Monday, March 26, 2018 7:34 AM
• Oh,it look nice and I'll try it here at my site and let you know the result ;-))

Monday, March 26, 2018 8:36 AM
• YES ... it seems like the arrow head is stable now !

But the FIRST subdivider to the left is GRAY and the code shows color is NOT defined, I think:

```      ' then insert the years and some subdividers
(msoConnectorStraight, leftSpace, topSpace - 10, leftSpace, topSpace)
Set subDivider = Nothing       <<<<<<<<<<<<<< NO COLOR FOR THE FIRST SUBDIVIDER - right ?
For x = 1 To endYear - startYear + 1 (BTW: How can I get OUT of this code frame again ???)But the collering is a minor problem, so I'll mark the thread is solved ;-))```

EDIT: here is the coloring right:

```        Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace, topSpace - 10, leftSpace, topSpace)
subDivider.Line.ForeColor.RGB = ColorConstants.vbBlue
Set subDivider = Nothing
```

• Edited by Monday, March 26, 2018 9:42 AM
Monday, March 26, 2018 9:36 AM
• Hi Ksor2,

You had mentioned that,"But the FIRST subdivider to the left is GRAY and the code shows color is NOT defined, I think:"

I try to make a test again with the same code.

You can see that all the subdivider are color in blue.

You had edited the post,"EDIT: here is the coloring right:"

If not, Let us inform about that.

We will try to provide further suggestions to solve the issue.

Regards

Deepak

MSDN Community Support
Please remember to click "Mark as Answer" the responses that resolved your issue, and to click "Unmark as Answer" if not. This can be beneficial to other community members reading this thread. If you have any compliments or complaints to MSDN Support, feel free to contact MSDNFSF@microsoft.com.

Tuesday, March 27, 2018 7:32 AM
• ALL OK now - jobs done - thx !

Tuesday, March 27, 2018 12:49 PM