Create hyperlinks with Shapes

This code finds and matches the Text value of a Shape to the value of a cell on seperate worksheets within the same workbook.

Sub bbb()    'Creat hyperlinks to shape by text value
Dim shpTemp As Shape
Dim ShtRange   'ShtRange
Dim ShtLastRow    'ShtLastRow
Dim ShtCell    'ShtCell


If Left(ActiveWorkbook.Name, 3) = "MOT" Then
    With Sheets("Sheet1")    'Loop thru Column D
        ShtLastRow = .Cells(Rows.Count, "D").End(xlUp).Row
        Set ShtRange = .Range("D10:D" & ShtLastRow)
    End With
End If
If Left(ActiveWorkbook.Name, 6) = "AS9102" Then
    With Sheets("Sheet3")    'Loop thru Column A
        ShtLastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        Set ShtRange = .Range("A6:A" & ShtLastRow)
    End With
End If

For Each shpTemp In ActiveSheet.Shapes
    For Each ShtCell In ShtRange
        If shpTemp.AutoShapeType = msoShapeOval Then
            With shpTemp.TextFrame
                If .Characters.Text = ShtCell Then
                    MsgBox .Characters.Text & " " & ShtCell    'for testing
                    MsgBox shpTemp.Name & " " & ShtCell    'for testing
                    'Create hyperlinks?
                    ActiveSheet.Shapes(shpTemp.Name).Select
                    ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), _
                            Address:="", SubAddress:=ShtCell
                End If
            End With
        End If
    Next ShtCell
Next shpTemp
End Sub

Questions:
How can I write code to create a hyper link from the Shape to the cell? If the user clicks on the shape it links to a cell and vise~versa.
My attempt above fails, it seems to go thru the first found shape but generates an error after the second found shape.
No hyperlinks are created.

Run-time error '5':
Invalid procedure call or argument