Sub FixComments()
  Dim Rng As Range, Cell As Range
  On Error Resume Next
  Set Rng = Selection.SpecialCells(xlCellTypeComments)
  If Rng Is Nothing Then
    If ActiveSheet.ProtectContents Then
      MsgBox "Сначала снимите защиту листа", vbExclamation, "FixComments"
    Else
      MsgBox "Нет примечаний в выделенном диапазоне", vbExclamation, "FixComments"
    End If
    Exit Sub
  End If
  On Error GoTo exit_
  For Each Cell In Rng
    With Cell.Comment.Shape
      .Top = Cell.Top - 10
      .Left = Cell.Left + Cell.Width + 10
      .Height = 50
      .Width = 110
    End With
  Next
  MsgBox "Исправлено примечаний: " & Rng.Cells.Count, vbInformation, "FixComments"
exit_:
  If Err Then MsgBox Err.Description, vbCritical, "FixComments"
End Sub