---

Sub Найти_Повторения_И_Сортировать()
    Dim wsSource As Worksheet
    Dim wsNew As Worksheet
    Dim shp As Shape
    Dim r As Long
    Dim lastRow As Long
    
    ' Запоминаем текущий лист с фигурами
    Set wsSource = ActiveSheet
    
    ' Проверяем, есть ли вообще фигуры на листе
    If wsSource.Shapes.Count = 0 Then
        MsgBox "На этом листе нет никаких фигур!", vbExclamation, "Ошибка"
        Exit Sub
    End If
    
    ' Отключаем обновление экрана для скорости
    Application.ScreenUpdating = False
    
    ' Создаем новый лист для отчета
    Set wsNew = Sheets.Add
    On Error Resume Next
    wsNew.Name = "Анализ_Фигур_" & Format(Now, "hh_mm_ss")
    On Error GoTo 0
    
    ' Создаем шапку таблицы
    wsNew.Range("A1").Value = "Название фигуры"
    wsNew.Range("B1").Value = "Тип фигуры"
    wsNew.Range("A1:B1").Font.Bold = True
    wsNew.Range("A1:B1").Interior.Color = RGB(220, 220, 220)
    
    ' 1. Собираем все фигуры в таблицу
    r = 2
    For Each shp In wsSource.Shapes
        wsNew.Cells(r, 1).Value = shp.Name
        wsNew.Cells(r, 2).Value = shp.Type
        r = r + 1
    Next shp
    
    lastRow = r - 1
    
    ' 2. Сортируем полученный список по алфавиту (колонка A)
    With wsNew.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=wsNew.Range("A2:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange wsNew.Range("A1:B" & lastRow)
        .Header = xlYes
        .Apply
    End With
    
    ' 3. Ищем дубликаты и подсвечиваем их красным
    ' Используем встроенное Условное форматирование Excel
    Dim rng As Range
    Set rng = wsNew.Range("A2:A" & lastRow)
    rng.FormatConditions.AddUniqueValues
    rng.FormatConditions(rng.FormatConditions.Count).SetFirstPriority
    rng.FormatConditions(1).DupeUnique = xlDuplicate
    
    ' Задаем нежно-красную заливку для повторов
    With rng.FormatConditions(1).Interior
        .PatternColorIndex = xlAutomatic
        .Color = RGB(255, 199, 206)
    End With
    ' Задаем темно-красный цвет текста для повторов
    With rng.FormatConditions(1).Font
        .Color = RGB(156, 0, 6)
    End With
    
    ' Красиво выравниваем ширину колонок
    wsNew.Columns("A:B").AutoFit
    
    ' Включаем экран обратно
    Application.ScreenUpdating = True
    
    ' Сообщаем пользователю
    MsgBox "Готово! Создан новый лист со списком." & vbCrLf & _
           "Фигуры отсортированы по алфавиту." & vbCrLf & _
           "Повторяющиеся имена подсвечены красным цветом.", vbInformation, "Успех"
End Sub