Question

我需要一些关于Powerpoint中一些奇怪的VBA代码行为的帮助。目的很简单 - 更新Powerpoint演示文稿上的Excel链接。我有一个与Excel文件链接的对象的演示文稿。在从Powerpoint运行代码时，系统会提示用户选择硬盘驱动器上的源Excel文件，此Excel文件的位置用于替换已保存在PowerPoint演示文稿中的Excel文件的先前位置。您运行宏，检查链接，更新其路径。单击“保存”，关闭演示文稿。你打开演示文稿，一切都很好。现在假设您更改了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

运行Powerpoint VBA更新Excel链接时出现奇怪的行为

0 个答案: