Set tb(i) = ConertUnit.Controls.Add("forms.textbox.1")
                With tb(i)
                        .BackColor = &H80000005
                        .BackStyle = 1
                        .BorderStyle = 0
                        .ForeColor = &H80000008
                        .TextAlign = 2
                        .Font.Size = 10
                        .Font.Bold = True
                        .Font.Name = "Tahoma"
                        .Top = i * 10 + (i - 1) * 20 'От верхней границы границы формы
                        .Left = 86
                        .Height = 18
                        .Width = 78
                End With

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    Dim i
    For i = LBound(arr) To UBound(arr)
        If arr(i) = stringToBeFound Then
            IsInArray = True
            Exit Function
        End If
    Next i
    IsInArray = False
    
End Function

Sub changeLinkTargets()
Application.DisplayAlerts = False


Dim pptSlide As Slide
Dim pptShape As Shape
Dim oldlinks(10) As String
Dim newlinks(10) As String
Dim temp As String
Dim counter As Integer
counter = 0



For Each pptSlide In ActivePresentation.Slides
    For Each pptShape In pptSlide.Shapes
        If pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoLinkedPicture Then
            With pptShape.LinkFormat
                 
                        temp = Left(.SourceFullName, InStr(.SourceFullName, "!") - 1)
                   
                  If Not IsInArray(temp, oldlinks) Then
                    oldlinks(counter) = temp
                    counter = counter + 1
                End If
            End With
        End If
    'DoEvents
    Next pptShape
'DoEvents
Next pptSlide


Dim fd As FileDialog
Dim fullpath As String
Dim fileselected As Variant




Set fd = Application.FileDialog(msoFileDialogOpen)




For i = 0 To counter - 1
    MsgBox (oldlinks(i))
    With fd

    .AllowMultiSelect = False
    .Show
        
    newlinks(i) = .SelectedItems.Item(1)

    End With
    


    
    For Each pptSlide In ActivePresentation.Slides
        For Each pptShape In pptSlide.Shapes
            If pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoLinkedPicture Then
                With pptShape.LinkFormat
                
                    If InStr(1, UCase(.SourceFullName), UCase(oldlinks(i))) Then
                        .SourceFullName = Replace(.SourceFullName, oldlinks(i), newlinks(i))
                    End If
                End With
            End If
        'DoEvents
        Next pptShape
    'DoEvents
    Next pptSlide
Next i

MsgBox ("Ура, сработало!")

End Sub


'Эта часть кода обновляет данные на слайдах после замены связей
Sub UpdateLinkTargets()
Dim pptSlide As Slide
Dim pptShape As Shape

For Each pptSlide In ActivePresentation.Slides
    For Each pptShape In pptSlide.Shapes
        If pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoLinkedPicture Then
            With pptShape.LinkFormat
               .Update
            End With
        End If

    'DoEvents
    Next pptShape
'DoEvents
Next pptSlide

MsgBox ("Ура, сработало!")
End Sub