Sub AddCheckBoxes()
   On Error Resume Next
   Dim c As Range, myRange As Range
   Set myRange = Selection
   For Each c In myRange.Cells
   ActiveSheet.CheckBoxes.Add(c.Left, c.Top, c.Width, c.Height).Select
   With Selection
   .LinkedCell = c.Address
   .Characters.Text = ""
   .Name = c.Address

   End With
   Next
   myRange.Select
  End Sub