Macro button to add value in corresponding cell

Alecs 

Assign the following macro to the Add shape:

Sub RoundedRectangle2_Click()
    Dim wk As String
    Dim rg As Range
    Dim tm As Date
    If Intersect(Range("B4:B10000"), ActiveCell) Is Nothing Then
        MsgBox "Please select a cell with working hours in column B!", vbInformation
        Exit Sub
    End If
    If ActiveCell.Offset(0, -1).Value = "" Then
        MsgBox "Please select a cell with a week number to the left!", vbExclamation
        Exit Sub
    End If
    If Val(ActiveCell.Value) <= 0 Then
        MsgBox "Please enter a valid working time!", vbInformation
        Exit Sub
    End If
    wk = ActiveCell.Offset(0, -1).Value
    Set rg = Range("E2:BE2").Find(What:=wk, LookAt:=xlWhole)
    If rg Is Nothing Then
        MsgBox "Week number not found!", vbInformation
        Exit Sub
    End If
    tm = Val(ActiveCell.Value)
    With Cells(ActiveCell.Row, rg.Column)
        .Value = .Value + tm
    End With
End Sub