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
Next pptShape
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
Next pptShape
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
Next pptShape
Next pptSlide
MsgBox ("Ура, сработало!")
End Sub
делаю модель оценки и вяжу отчеты в презентацию. но при отправке файла заказчику, меняется путь. как макросом заменить все пути для всех отчетов?