none
Maybe overflow somewhere ... or what else ? RRS feed

  • 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 .Line.EndArrowheadStyle = msoArrowheadOpen .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 Sub

    Public Sub deleteAllShapes()
        ActiveSheet.DrawingObjects.Delete
    End Sub


    Saturday, March 24, 2018 11:50 PM

Answers

  • 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 .Line.EndArrowheadStyle = msoArrowheadOpen

    .Name = "Timeline" End With

    New Code:

     With arrow
                .Line.ForeColor.RGB = ColorConstants.vbBlue
                .Line.EndArrowheadStyle = msoArrowheadTriangle
                .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 Ksor2 Monday, March 26, 2018 9:36 AM
    Monday, March 26, 2018 7:34 AM
    Moderator

All replies

  • Hi Ksor2,

    I've been impressed by your work.
    So, I modified your code.


    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 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 .Line.EndArrowheadStyle = msoArrowheadOpen .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 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 Ashidacchi 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 Ksor2 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 Ksor2 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 .Line.EndArrowheadStyle = msoArrowheadOpen

    .Name = "Timeline" End With

    New Code:

     With arrow
                .Line.ForeColor.RGB = ColorConstants.vbBlue
                .Line.EndArrowheadStyle = msoArrowheadTriangle
                .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 Ksor2 Monday, March 26, 2018 9:36 AM
    Monday, March 26, 2018 7:34 AM
    Moderator
  • Oh,it look nice and I'll try it here at my site and let you know the result ;-))

    Thx for your time !

    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 Set subDivider = ActiveSheet.Shapes.AddConnector _ (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 Ksor2 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:"

    Does that solve your issue?

    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
    Moderator
  • ALL OK now - jobs done - thx !

    Tuesday, March 27, 2018 12:49 PM