Option Explicit
Sub ClearLinesFromChart()
Dim shp As Shape
For Each shp In ActiveSheet.ChartObjects(1).Chart.Shapes
If InStr(shp.Name, "DL_") > 0 Then shp.Delete
Next
End Sub
Sub Test_DrawVerticalLinesOnChart()
DrawVerticalLinesOnChart (Array(CDate("1/15/17"), 255, 1))
DrawVerticalLinesOnChart (Array(CDate("3/5/17"), 255, 1.5))
DrawVerticalLinesOnChart (Array(CDate("6/21/17"), rgbBlue, 4))
DrawVerticalLinesOnChart (Array(CDate("4/14/14"), 255, 2))
End Sub
Function DrawVerticalLinesOnChart(aryInput As Variant)
'aryInput is a (0 to 2, 1 to n) array with the 0 a date, 1 a long value for color.
' (2) a single value for thickness (0.25 to 10)
'If the date is in the range of teh chart then the line will be plotted
Dim dteMin As Date
Dim dteMax As Date
Dim dteInput As Date
Dim lColor As Long
Dim sngThick As Single
Dim sngXIncrementCoord As Single
Dim sngXCoord As Single
Dim aryXValues As Variant
Dim lPointCount As Long
Dim lPointIndex As Long
Dim sngLowerPointXCoord As Single
Dim sngLowerPointYCoord As Single
Dim sngUpperPointXCoord As Single
Dim sngUpperPointYCoord As Single
Dim dteLower As Date
Dim dteUpper As Date
Dim bSkip As Boolean
Dim lLowerPoint As Long
Dim lUpperPoint As Long
dteInput = aryInput(0)
lColor = aryInput(1)
sngThick = aryInput(2)
aryXValues = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).XValues
For lPointIndex = LBound(aryXValues) To UBound(aryXValues)
aryXValues(lPointIndex) = CDate(aryXValues(lPointIndex))
Next
For lPointIndex = LBound(aryXValues) To UBound(aryXValues) - 1
If dteInput = aryXValues(lPointIndex) Then
lLowerPoint = lPointIndex
lUpperPoint = lPointIndex
Exit For
End If
If dteInput > aryXValues(lPointIndex) And dteInput < aryXValues(lPointIndex + 1) Then
lLowerPoint = lPointIndex
Exit For
End If
Next
If lLowerPoint = 0 Then
'Date not in graph range
bSkip = True
ElseIf lLowerPoint = lUpperPoint Then
sngXCoord = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(lLowerPoint).Left
ElseIf lLowerPoint < UBound(aryXValues) Then
'Specified date is between two points on the chart
dteLower = aryXValues(lLowerPoint)
dteUpper = aryXValues(lLowerPoint + 1)
sngLowerPointXCoord = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(lLowerPoint).Left
sngUpperPointXCoord = ActiveSheet.ChartObjects(1).Chart.SeriesCollection(1).Points(lLowerPoint + 1).Left
sngXIncrementCoord = (sngUpperPointXCoord - sngLowerPointXCoord) * (dteInput - dteLower) / (dteUpper - dteLower)
sngXCoord = sngLowerPointXCoord + sngXIncrementCoord
End If
If Not bSkip Then
bSkip = False
ActiveSheet.ChartObjects(1).Select
With ActiveSheet.ChartObjects(1).Chart.PlotArea
sngUpperPointYCoord = .Top
sngLowerPointYCoord = sngUpperPointYCoord + .InsideHeight
End With
ActiveChart.Shapes.AddConnector(msoConnectorStraight, _
sngXCoord, sngUpperPointYCoord, sngXCoord, sngLowerPointYCoord).Select
With Selection.ShapeRange.Line
.Visible = msoTrue
.ForeColor.RGB = lColor
.Transparency = 0
.Weight = sngThick
End With
Selection.ShapeRange.Name = "DL_" & sngXCoord
End If
End Function