Printable View
just an arrow with some years on ... maybe subdivisions for each year and an arrowhead to the right !
I want to place shapes along that line representing events on specific dates.
I have Googled and found a lot of way too sophisticated code within charts and so ... useless, I think !
Something like this - ofcause with all the years 1980 to 1989 ... ranging max 120 years:
Attachment 21904
and generated with this call:
call timeline (startYear, endyear)
As simple an easy as it could be - thx !
SIGHQuote:
As simple an easy as it could be
I'm getting too old for this
Yeah, me too !
I can do that in about 30 seconds on a worksheet with Fill >> Series and Borders
Record a macro and share it with us
Ps: the # icon will insert Code Formatting Tags [Brackets] around selected Code.
Then use 60 seconds to make it by VBA and teach me ;-))
Code:Sub Macro2()
'
' Macro2 Macro
' Macro recorded 3/24/2018 by SamT
'
'
Selection.DataSeries Rowcol:=xlRows, Type:=xlLinear, Step:=1
Range("A1:O2").Select
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
End Sub
Ha, ha ... nothing to do with graphics !
OK, let me explain why I don't think I can use any of these sophisticated built-in charts !
I have some events happening over 10, 50, 100 maybe 200 years on specific dates in that range of years.
I want to draw a "timeline" from the date 01-01-FIRSTYEAR to the date 31-12-LASTYEAR looking something like the one in my first posting.
I'll use the whole width of the "graphic plate" ... or what it's called.
I now wants to place some shapes - let's say small red dots, 2-3mm in diameter - for every event I have to place.
The event dates kind of predicts where along the timeline - maybe 5 mm below - the events will be placed from left to right.
I have the events in a table in Access, but never mind that - I'll just call Excel sub from over there in Access.
Some seudo-code could look like this:
makeTimeline (startYear, endyear)
For each event placeEvent(eventDate, furtherInfoForShowingInToolTipForThisEvent)
I know how to:
turn off ALL rows/columns and cells so I just gave a "white paper" = "graphic plate"
run code in Excel from Access.
place shapes correctly
make tooltips for shapes
clean up the shapes ect, ect
I just cant figure out how to generate that stupid timeline flowting on this "white paper" I now have !
Presume there is an open Excel sheet preset to just a "white paper" and all shapes needed for the timeline should be generated by VBA
OR
maybe it's posible to "steal" an axis looking nearly what I want from a built-in chart somewhere !
Not 100% sure that I understand what this is ...
Quote:
that stupid timeline flowting on this "white paper" I now have !
... but maybe this will work as a start
Attachment 21909
It'd be easy enough to add formatting, etc.
Code:Option Explicit
Sub drv()
Call MakeTimeline(1980, 2030)
End Sub
Sub MakeTimeline(Y1 As Long, Y2 As Long)
Dim ws As Worksheet
Dim y As Long
Dim rYears As Range, rMarkers As Range
Set ws = Worksheets("TimeLine")
With ws
For y = Y1 To Y2
.Cells(1, y - Y1 + 2).Value = y
Next y
Set rYears = .Cells(1, 2).CurrentRegion
With rYears
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
Set rMarkers = rYears.Offset(2, 0).Resize(2, Y2 - Y1 + 1)
With rMarkers
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = xlAutomatic
.TintAndShade = 0
.Weight = xlThick
End With
End With
End With
End Sub
Some nice code you made there but again it has nothing to do with graphics !
What I mean by "white paper" is the way the WorkSheet looks like when rows/columns and cells are turned off.
"... but maybe this will work as a start" - it's a "dead end" when it should end up as graphic-mode - you are aiming at a wrong target.
HERE is a real start, aiming at the right target !
Simple an easy as it could be ... but not as simple as I would have exspected though !
Just have an empty Worksheet in Excel, insert the code in a module.
Call the 2 subs from the immidiate window to test it !
Now I just needs to find out where to turn off the frame around the year !
I think it has to do with the commented out line .LineStyle = xlLineStyleNone, but I can't figure out how it works !
Can you ?
Code:
Public Sub timeLine(startYear As Integer, endYear As Integer)
Const leftSpace = 200
Const yearSpace = 40
Const stickOut = 20
Dim arrow As Shape, yearBox As Shape, x As Integer, subDivider As Shape
If startYear < endYear Then
' first draw the timeline as an arrow the length of (endYear-startYear)*yearSpace
Set arrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace - stickOut, 100, _
leftSpace + (endYear - startYear + 1) * yearSpace + stickOut, 100)
With arrow
.Line.EndArrowheadStyle = msoArrowheadOpen
.Name = "Timeline"
End With
Set arrow = Nothing
' then insert the years and some subdividers
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace, 90, leftSpace, 100)
Set subDivider = Nothing
For x = 1 To endYear - startYear + 1
Set yearBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, leftSpace + (x - 1) * yearSpace, 75, 37, 20)
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace - stickOut + yearSpace / 2 + x * yearSpace, 90, _
leftSpace - stickOut + yearSpace / 2 + x * yearSpace, 100)
'.LineStyle = xlLineStyleNone <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
With yearBox.TextFrame
.Characters.Text = startYear - 1 + x
End With
Set yearBox = Nothing
Next x
End If
End Sub
Public Sub deleteAllShapes()
ActiveSheet.DrawingObjects.Delete
End Sub
I didn't think that was possible. How do you do that.Quote:
I know how to: turn off ALL rows/columns and cells
Sorry, I didn't get the 'right target' out of the first posts
Quote:
Originally Posted by ksor
Look at the marked line - it's as simple and as easy as could be
Code:Public Sub timeLine(startYear As Integer, endYear As Integer)
Const leftSpace = 200
Const yearSpace = 40
Const stickOut = 20
Dim arrow As Shape, yearBox As Shape, x As Integer, subDivider As Shape
If startYear < endYear Then
' first draw the timeline as an arrow the length of (endYear-startYear)*yearSpace
Set arrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace - stickOut, 100, _
leftSpace + (endYear - startYear + 1) * yearSpace + stickOut, 100)
With arrow
.Line.EndArrowheadStyle = msoArrowheadOpen
.Name = "Timeline"
End With
Set arrow = Nothing
' then insert the years and some subdividers
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace, 90, leftSpace, 100)
Set subDivider = Nothing
For x = 1 To endYear - startYear + 1
Set yearBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, leftSpace + (x - 1) * yearSpace, 75, 37, 20)
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace - stickOut + yearSpace / 2 + x * yearSpace, 90, _
leftSpace - stickOut + yearSpace / 2 + x * yearSpace, 100)
With yearBox
.TextFrame.Characters.Text = startYear - 1 + x
.Line.Visible = msoFalse ' <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
End With
Set yearBox = Nothing
Next x
End If
End Sub
BTW, it would have been a lot easier if you had provided in your first post: 1) the code your were using, 2) a sample workbook, and 3) asked more accurately "How can I remove the lines around the year TextBoxes?"
I'm guessing that OP means [View], and uncheck Grid, Headings, and Formula Bar (but my guesses haven't been very good here of late)
"OP" ????? ... I don't get you !
How could I show the code when I don't have it on that time ?
Here is a better solution ... call with - lets say 1900,2018 ... works nicely:
Code:Public Sub timeLine(startYear As Integer, endYear As Integer)
Const leftSpace = 200
Const yearSpace = 100
Const stickOut = 20
Const yearBoxWidth = 38
Dim arrow As Shape, yearBox As Shape, x As Integer, subDivider As Shape, subX As Integer
If startYear <= endYear Then
' first draw the timeline as an arrow the length of (endYear-startYear+1)*yearSpace
Set arrow = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace - stickOut, 100, _
leftSpace + (endYear - startYear + 1) * yearSpace + 1.8 * stickOut, 100)
With arrow
.Line.EndArrowheadStyle = msoArrowheadOpen
.Name = "Timeline"
End With
Set arrow = Nothing
' then insert the years and some subdividers
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, leftSpace, 90, leftSpace, 100)
Set subDivider = Nothing
For x = 1 To endYear - startYear + 1
Set yearBox = ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, leftSpace + (x - 1) * yearSpace + yearSpace / 2 - yearBoxWidth / 2, _
75, yearBoxWidth, 20)
subX = leftSpace + x * yearSpace
Set subDivider = ActiveSheet.Shapes.AddConnector(msoConnectorStraight, subX, 90, subX, 100)
'.LineStyle = xlLineStyleNone
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
I tried it out with different parameters and then something happens !
If you call timeLine (1950,2018) AND set the yearSpace =215 - there is a nice arrowhead fare out to the right !
If you set the yearSpace=216 there is NO ARROWHEAD out there !
Maybe the calculated X-value is too big somewhere in the haystack ... or what else ?
I have tried to declare all the const as Long ... same problem !
Quote:
Originally Posted by ksor
"OP" = Original Poster, i.e. the person who first started the thread, i.e. that'd be you
I'm glad you have a better solution that works