Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count = 1 Then
        If ActiveCell.Column > 10 Then
            Cells(Target.Row, 2).Select
        End If
    End If
End Sub

Sub SetReadOnlyAttribute()
    Dim fso As FileSystemObject
    Dim file As File
    
    ' Создаем объект FileSystemObject
    Set fso = New FileSystemObject
    
    ' Путь к файлу
    Dim filePath As String
    filePath = "C:\Users\shishigin_vs\Desktop\1график 7зк.xlsx"
    
    ' Проверяем, существует ли файл
    If fso.FileExists(filePath) Then
        ' Получаем объект файла
        Set file = fso.GetFile(filePath)
        
        ' Устанавливаем атрибут "Только чтение"
        file.Attributes = file.Attributes Or ReadOnlyAttribute
        
        MsgBox "Атрибут 'Только чтение' установлен для файла: " & filePath
    Else
        MsgBox "Файл не найден: " & filePath
    End If
    
    ' Очищаем объекты
    Set file = Nothing
    Set fso = Nothing
End Sub

Sub InsertImagesToCellsRandomOrder()
    Dim ws As Worksheet
    Dim cell As Range
    Dim imagePath As String
    Dim img As Picture
    Dim fileDialog As fileDialog
    Dim filePaths() As String
    Dim i As Integer
    Dim imgAspectRatio As Double
    Dim randomIndex As Integer
    Dim temp As String
    Dim newWidth As Double, newHeight As Double

    ' Используем активный лист
    Set ws = ActiveSheet

    ' Создаем диалог для выбора изображений
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    fileDialog.AllowMultiSelect = True
    fileDialog.Filters.Clear
    fileDialog.Filters.Add "Images", "*.jpg; *.jpeg; *.png; *.bmp; *.gif", 1

    ' Показываем диалог
    If fileDialog.Show = -1 Then
        ' Создаем массив для сохранения выбранных путей изображений
        ReDim filePaths(1 To fileDialog.SelectedItems.Count)
        
        ' Сохраняем выбранные пути изображений в массив
        For i = 1 To fileDialog.SelectedItems.Count
            filePaths(i) = fileDialog.SelectedItems(i)
        Next i

        ' Перемешиваем список файлов (алгоритм Fisher-Yates)
        For i = LBound(filePaths) To UBound(filePaths)
            randomIndex = Int((UBound(filePaths) - LBound(filePaths) + 1) * Rnd + LBound(filePaths))
            temp = filePaths(i)
            filePaths(i) = filePaths(randomIndex)
            filePaths(randomIndex) = temp
        Next i

        ' Вставляем изображения в ячейки
        For i = 1 To UBound(filePaths)
            imagePath = filePaths(i)

            ' Проверяем, есть ли еще ячейки для вставки
            If i > Selection.Cells.Count Then Exit For

            Set cell = Selection.Cells(i)
            Set img = ws.Pictures.Insert(imagePath)

            ' Получаем соотношение сторон изображения
            imgAspectRatio = img.Width / img.Height

            ' Определяем новые размеры
            If imgAspectRatio > 1.1 Then
                ' Портретные изображения (ширина больше высоты)
                img.ShapeRange.LockAspectRatio = msoFalse
                img.ShapeRange.Rotation = 90 ' Поворачиваем изображение
                img.Width = cell.Height - 2 ' Ширина изображения будет равна высоте ячейки
                img.Height = img.Width / imgAspectRatio - 2 ' Высота устанавливается по соотношению
            Else
                ' Альбомные изображения
                If imgAspectRatio >= 0.9 And imgAspectRatio <= 1.1 Then
                    ' Если изображение почти квадратное, устанавливаем одинаковые размеры
                    img.Width = cell.Width - 4
                    img.Height = img.Width - 5 ' Устанавливаем высоту равной ширине
                Else
                    If imgAspectRatio > 1 Then
                        img.Width = cell.Width - 2
                        img.Height = img.Width / imgAspectRatio - 2
                    Else
                        img.Height = cell.Height - 2
                        img.Width = img.Height * imgAspectRatio - 2
                    End If
                End If
            End If

            ' Центрируем изображение в ячейке
            img.Top = cell.Top + (cell.Height - img.Height) / 2
            img.Left = cell.Left + (cell.Width - img.Width) / 2
        Next i
    End If
End Sub

Sub InsertImagesToCellsRandomOrder()
    Dim ws As Worksheet
    Dim cell As Range
    Dim imagePath As String
    Dim img As Picture
    Dim fileDialog As fileDialog
    Dim filePaths() As String
    Dim i As Integer
    Dim imgAspectRatio As Double
    Dim cellAspectRatio As Double
    Dim randomIndex As Integer
    Dim temp As String

    ' Укажите лист Excel
    Set ws = ThisWorkbook.ActiveSheet ' Укажите название листа

    ' Создаем диалог для выбора изображений
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    fileDialog.AllowMultiSelect = True
    fileDialog.Filters.Clear
    fileDialog.Filters.Add "Images", "*.jpg; *.jpeg; *.png; *.bmp; *.gif", 1

    ' Показываем диалог
    If fileDialog.Show = -1 Then
        ' Создаем массив для сохранения выбранных путей изображений
        ReDim filePaths(1 To fileDialog.SelectedItems.Count)
        
        ' Сохраняем выбранные пути изображений в массив
        For i = 1 To fileDialog.SelectedItems.Count
            filePaths(i) = fileDialog.SelectedItems(i)
        Next i

        ' Перемешиваем список файлов (алгоритм Fisher-Yates)
        For i = LBound(filePaths) To UBound(filePaths)
            randomIndex = Int((UBound(filePaths) - LBound(filePaths) + 1) * Rnd + LBound(filePaths))
            temp = filePaths(i)
            filePaths(i) = filePaths(randomIndex)
            filePaths(randomIndex) = temp
        Next i

        ' Вставляем изображения в ячейки
        For i = 1 To UBound(filePaths)
            imagePath = filePaths(i)

            ' Проверяем, есть ли еще ячейки для вставки
            If i > Selection.Cells.Count Then Exit For

            Set cell = Selection.Cells(i)
            Set img = ws.Pictures.Insert(imagePath)

            ' Получаем размеры и пропорции
            imgAspectRatio = img.Width / img.Height
            cellAspectRatio = cell.Width / cell.Height

            ' Масштабируем изображение, сохраняя пропорции
            If imgAspectRatio > cellAspectRatio Then
                img.Width = cell.Width - 1
                img.Height = img.Width / imgAspectRatio - 1
            Else
                img.Height = cell.Height - 1
                img.Width = img.Height * imgAspectRatio - 1
            End If

            ' Центрируем изображение в ячейке
            img.Top = cell.Top + (cell.Height - img.Height) / 2
            img.Left = cell.Left + (cell.Width - img.Width) / 2
        Next i
    End If
End Sub

Sub InsertImagesToCells()
    Dim ws As Worksheet
    Dim cell As Range
    Dim imagePath As String
    Dim img As Picture
    Dim fileDialog As fileDialog
    Dim filePaths As Variant
    Dim i As Integer
    Dim imgAspectRatio As Double
    Dim cellAspectRatio As Double

    ' Укажите лист Excel
    Set ws = ThisWorkbook.ActiveSheet ' Укажите название листа

    ' Создаем диалог для выбора изображений
    Set fileDialog = Application.fileDialog(msoFileDialogFilePicker)
    fileDialog.AllowMultiSelect = True
    fileDialog.Filters.Clear
    fileDialog.Filters.Add "Images", "*.jpg; *.jpeg; *.png; *.bmp; *.gif", 1

    ' Показываем диалог
    If fileDialog.Show = -1 Then
        ' Сохраняем выбранные пути изображений
        For i = 1 To fileDialog.SelectedItems.Count
            imagePath = fileDialog.SelectedItems(i)

            ' Проверяем, есть ли еще ячейки для вставки
            If i > Selection.Cells.Count Then Exit For

            Set cell = Selection.Cells(i)
            Set img = ws.Pictures.Insert(imagePath)

            ' Получаем размеры и пропорции
            imgAspectRatio = img.Width / img.Height
            cellAspectRatio = cell.Width / cell.Height

            ' Масштабируем изображение, сохраняя пропорции
            If imgAspectRatio > cellAspectRatio Then
                img.Width = cell.Width - 1
                img.Height = img.Width / imgAspectRatio - 1
            Else
                img.Height = cell.Height
                img.Width = img.Height * imgAspectRatio
            End If

            ' Центрируем изображение в ячейке
            img.Top = cell.Top + (cell.Height - img.Height) / 2
            img.Left = cell.Left + (cell.Width - img.Width) / 2
        Next i
    End If
End Sub

=СУММПРОИЗВ(($A$1:$A$29=A1)*1)

let
    Source = Excel.CurrentWorkbook()
{[Name="emails"]}[Content], FirstRow=Source{0}
[Column1],
SplitText=Text.Split(FirstRow, ", "),
ResultTable=Table.FromList(SplitText,Splitter.SplitByNothing(),{"Column1"})
in
    ResultTable

' Предположим, что нужно получить первый элемент из выборки
Set firstElement = xmlSelect.Item(0)

' Теперь можно работать с атрибутами этого элемента
Dim attributeValue
attributeValue = firstElement.getAttribute("yourAttributeName")

' Вывод значения атрибута
MsgBox attributeValue

Sub Макрос1()
    Range(Split(Range("I9").Formula, "=")(1)).ClearContents
End Sub