Sub Макрос1()
    Dim adr$
    For Each Sh In ActiveSheet.Shapes
        If Sh.TopLeftCell.Column >= 28 And Sh.BottomRightCell.Column <= 30 Then
            If Sh.VerticalFlip Then
                adr = Sh.TopLeftCell.Offset(, Sh.BottomRightCell.Column - Sh.TopLeftCell.Column + 1).Address
            Else
                adr = Sh.BottomRightCell.Offset(, 1).Address
            End If
            ActiveSheet.Hyperlinks.Add Anchor:=Sh, Address:=""
            Sh.Hyperlink.SubAddress = ActiveSheet.Name & "!" & adr
        End If
    Next
End Sub

Public Function FileDialog_(ByVal Path As String, _
                            Optional MultiSelect As Boolean = True, _
                            Optional Expansion As String = "*.xlsm;*.xlsb;*.xlsx") As Variant
 
    Dim oFd    As FileDialog
    Dim s()    As Variant
    Dim lf     As Long
 
    Set oFd = Application.FileDialog(msoFileDialogFilePicker)
    With oFd     'используем короткое обращение к объекту
        .AllowMultiSelect = MultiSelect
        .Title = "Выбрать файлы:"     'заголовок окна диалога
        .Filters.Clear     'очищаем установленные ранее типы файлов
        .Filters.Add "Microsoft Excel Files", Expansion, 1     'устанавливаем возможность выбора только файлов Excel
        .InitialFileName = Path     'назначаем папку отображения и имя файла по умолчанию
        .InitialView = msoFileDialogViewDetails     'вид диалогового окна(доступно 9 вариантов)
        If .Show = 0 Then
            Call MsgBox("Не выбрано ни одного файла!", vbInformation, "Выбор файлов:")
            Exit Function     'показывает диалог
        End If
        ReDim Preserve s(1 To .SelectedItems.Count)
        For lf = 1 To .SelectedItems.Count
            s(lf) = CStr(.SelectedItems.Item(lf))     'считываем полный путь к файлу
        Next
    End With
    FileDialog_ = s
End Function


Private Function ReadTXTfile(ByVal FileName As String) As String    Dim FSO    As Object
    Dim ts     As Object
    Set FSO = CreateObject("scripting.filesystemobject")
    Set ts = FSO.OpenTextFile(FileName, 1, True): ReadTXTfile = ts.ReadAll: ts.Close
    Set ts = Nothing: Set FSO = Nothing
End Function

Sub Mac1()
    Range("G5:N16").ClearContents
End Sub