Странное поведение при запуске Powerpoint VBA при обновлении ссылок Excel

Question

Мне нужна помощь с поведением странного кода VBA в Powerpoint.Цель проста - обновить ссылки на Excel в презентации Powerpoint.У меня есть презентация с объектами, связанными с файлом Excel.При запуске кода из Powerpoint пользователю предлагается выбрать исходный файл Excel на жестком диске, и местоположение этого файла Excel используется для замены предыдущего местоположения файла Excel, уже сохраненного в презентации PowerPoint.Вы запускаете макрос, проверяете ссылки, их путь обновляется.Вы нажимаете сохранить, закрыть презентацию.Вы открываете презентацию и все хорошо.Допустим, вы изменили имя файла Excel.Вы запускаете макрос, проверяете ссылки, их путь обновляется.Вы нажимаете сохранить, закрыть презентацию.Вы открываете презентацию и обновляете только половину ссылок.Может ли кто-нибудь взглянуть?Спасибо!

Private Sub CommandButton1_Click()

Dim xlApp As Object
Dim xlWorkBook As Object

Dim pptSlide As Slide
Dim pptShape As Shape

Dim oldString, tempString, newString As String
Dim intLength As Integer

Dim sPath As String

Dim ExcelFileName As String

Dim fd As Office.FileDialog

    Set fd = Application.FileDialog(msoFileDialogFilePicker)

           With fd

              .AllowMultiSelect = False

              ' Set the title of the dialog box.
              .Title = "Please select the file to update links in the presentation"

              ' Clear out the current filters, and add our own.
              .Filters.Clear
              .Filters.Add "Excel Workbook", "*.xlsx"


              ' Show the dialog box. If the .Show method returns True, the
              ' user picked at least one file. If the .Show method returns
              ' False, the user clicked Cancel.
                  If .Show = True Then
                    newString = .SelectedItems(1) 'replace txtFileName with your textbox

                  End If
           End With

'show "macro running" screen
    UserForm1.Show False

'open excel file with links
    Set xlApp = CreateObject("Excel.Application")
    Set xlWorkBook = xlApp.Workbooks.Open(newString, True, False)

'grab old full path to replace link in objects

    For Each pptSlide In ActivePresentation.Slides
        For Each pptShape In pptSlide.Shapes
            If pptShape.Type = msoLinkedOLEObject Then
                    tempString = pptShape.LinkFormat.SourceFullName
                    intLength = InStr(tempString, "!")
                    oldString = Mid(tempString, 1, intLength - 1)
                GoTo 1
            End If
            If pptShape.Type = msoChart Then
                oldString = pptShape.LinkFormat.SourceFullName
                GoTo 1
            End If
        Next pptShape
    Next pptSlide
1

'replace old full path to new full path
    For Each pptSlide In ActivePresentation.Slides
        For Each pptShape In pptSlide.Shapes
            If pptShape.Type = msoLinkedOLEObject Or pptShape.Type = msoChart Then
                With pptShape.LinkFormat
                    If InStr(1, UCase(.SourceFullName), UCase(oldString)) Then
                        .SourceFullName = Replace(.SourceFullName, oldString, newString)
                    End If
                End With
            pptShape.LinkFormat.Update
            End If
        'DoEvents
        Next pptShape
    'DoEvents
    Next pptSlide

'close excel file with links
    xlWorkBook.Close (False)

    xlApp.Quit

    Set xlApp = Nothing
    Set xlWorkBook = Nothing

'hide "macro running" screen
UserForm1.Hide

End Sub