controlling the drawing tools by vba

[desmond_]

dear experts,

im wondering whether it is possible to control drawing tools s.a. shapes and lines by vba

if i have a huge project overview table and i want to add visual aids to point out certain milestones i have to spend a lot of time to do that manually
so i thought maybe i can let excel do that automatically
for example i have rows of projects and columns which show the months
now i simply enter the date (or just the month) and excel will put on that cell , lets say a red triangle
or if i want to indicate certain time blocks for a project i would enter start month and the end month and excel will put a line over all month in between

thanks a lot

Desmond

 

[My Aswer Is This]

Please and these questions:

Can I assume:
Your project name will be entered into column "A'
Your project start date will be entered into column "B"
Your project End date will be entered into column "C"

And columns "4" to "16" will be months starting in column "D" for January"

And you said:

and excel will put on that cell , lets say a red triangle

How can we put a triangle on a cell? Can we not just put a Reb Border around the cell or cells?

Or we could put a Shape Rectangle around the cell or cells.

 

[desmond_]

your assumption is correct,
i would like to add something more catchy than a border , that's why i mentioned triangle
i guess a rectangle would do the same job
in fact, currently i add triangles manually on the form, by the design tools

 

[My Aswer Is This]

Try this:
This script will run when you double click on any cell in column "A"
This script only works when Start Month is less then End Month

So it will not work if start date in July 1,2017 and end date is April,5 2018
Try this and if that is a problem for you check back and maybe I can work out that with some other way of doing this.
Put a Start Date in column "B"
Put a End Date in column "C"
Then double click in column "A" adjacent to your dates.
I have two script here:
Put this module script in your workbook

Sub Add_Box_To_Selection()
On Error GoTo M
Dim start As Long
Dim Last As Long
Dim Left  As Long
Dim Top As Long
Dim Width As Long
Dim Height As Long
start = Month(ActiveCell.Offset(, 1).Value) + 2
If start = 14 Then
MsgBox "You have not entered value in start column" & vbNewLine & "Or Start Month is later then End Month": Exit Sub
End If
Last = Month(ActiveCell.Offset(, 2).Value) + 3
If Last = 15 Then Last = start + 1
ActiveCell.Offset(, start).Resize(, Last - start).Select
Left = ActiveCell.Left
Top = ActiveCell.Top
Width = Selection.Width
Height = ActiveCell.Height
ActiveSheet.Shapes.AddShape(msoShapeRectangle, Left, Top, Width, Height).Select
With Selection.ShapeRange.Line
        .Visible = msoTrue
        .ForeColor.RGB = RGB(255, 0, 0)
        .Transparency = 0
        .Weight = 4.5
    End With
    
    Selection.ShapeRange.Fill.Visible = msoFalse
Cells(ActiveCell.Row, 1).Select
Exit Sub
M:
MsgBox "You have done something wrong"
End Sub

And put this script in your worksheet
This is an auto sheet event script
Your Workbook must be Macro enabled
To install this code:
Right-click on the sheet tab
Select View Code from the pop-up context menu
Paste the code in the VBA edit window

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If Target.Cells.Count > 1 Or IsEmpty(Target) Then Exit Sub
Cancel = True
Call Add_Box_To_Selection
End If
End Sub