0

我很难将早期绑定代码转换为后期绑定。我已经尝试了几次，但它不能正常工作。当涉及到早期绑定时，它运行良好。这是我的代码，我想请您向我展示它应该是什么样子以及我必须在哪些地方进行更改以及为了什么。

Sub PrezentacjaPP()

    Dim PowerPointA As PowerPoint.Application 'aplikacja PowerPoint
    Dim PrezentacjaPP As PowerPoint.Presentation 'prezentacja PowerPoint
    Dim NazwaPP As String 'nazwa pliku z szablonem prezentacji
    Dim SlajdPP As PowerPoint.Slide 'slajd prezentacji PowerPoint
    Dim WykresPP As PowerPoint.Shape 'wykres w formacie obrazu
    Dim Lista As String 'lista marek
    Dim Tekst As String 'tekst z info o marce i statystykami
    Dim i As Long 'numer marki
    Dim Wiersz As Long 'numer pierwszego wiersza dla danej marki

    Application.ScreenUpdating = False 'Wyłącz odświeżanie ekranu


        '1.Usunięcie starych prezentacji
        NazwaPP = Dir(ThisWorkbook.Path & "\" & "Prezentacja_*.pptx")
        If NazwaPP <> "" Then
            If MsgBox("Czy usunąć istniejące pliki z prezentacjami PowerPoint?", _
                vbYesNo + vbInformation) = vbYes Then
                Do While NazwaPP <> ""
                    Kill ThisWorkbook.Path & "\" & NazwaPP
                    NazwaPP = Dir()
                Loop
            Else
                MsgBox "Zmień nazwę istniejących prezentacji i ponownie uruchom procedurę."
                CzyZakonczyc = True
                Exit Sub
            End If
        End If

        '2. Wczytanie zmiennych
        ChDrive Left(ThisWorkbook.Path, 1) 'domyślny dysk
        ChDir ThisWorkbook.Path 'domyślny katalog
        NazwaPP = Application.GetOpenFilename(FileFilter:="Prezentacje programu PowerPoint (*.pptx), *.pptx", Title:="Zaznacz plik z szablonem prezentacji PowerPoint")
        If NazwaPP = "False" Then
            CzyZakonczyc = True
            Exit Sub
        End If

        '3. Wczytanie i otwarcie szablonu prezentacji PowerPoint
        Set PowerPointA = New PowerPoint.Application
        Set PrezentacjaPP = PowerPointA.Presentations.Open(NazwaPP) '<-- tylko w celach poglądowych podczas testowania makra

        '4. Stworzenie prezentacji
        With PrezentacjaPP

            '4.1. Uzupełnienie slajdów wstępnych
            .Slides(1).Shapes(1).TextFrame.TextRange = Cells(NrWiersza, "B").Value 'Slajd nr 1
            .Slides(2).Shapes(1).TextFrame.TextRange = "Lista marek" 'Slajd nr 2
            For i = 1 To Cells(Rows.Count, 18).End(xlUp).Row - 1
               Lista = Lista & Cells(i + 1, "R") & vbNewLine
            Next i
            .Slides(2).Shapes(2).TextFrame.TextRange = Lista

                '4.1.1. Stworzenie slajdów z aktywami
                 For i = 1 To Cells(Rows.Count, 18).End(xlUp).Row - 1
                     'Dodanie nowego slajdu (typ ppLayoutText: tytuł oraz pole tekstowe)
                     Set SlajdPP = .Slides.Add(.Slides.Count + 1, ppLayoutText)
                     With SlajdPP
                     'Wstawienie tytułu slajdu
                     .Shapes(1).TextFrame.TextRange = Cells(i + 1, "R")

            '4.2. Dodanie wykresów

                '4.2.1. Wykres 1
                ActiveSheet.Shapes.Range(Array("Picture" & " " & i * 2 - 1)).Select 'wykres w formacie obrazu w Excel'u
                Selection.Copy
                .Shapes.Paste
                Set WykresPP = .Shapes(SlajdPP.Shapes.Count)

                '4.2.2. Pozycjonowanie wykresu na slajdzie
                With WykresPP
                    .Left = 40
                    .Top = 110
                    .LockAspectRatio = msoFalse 'odblokowanie wsp. proporcji
                    .Width = 400
                    .Height = 195
                End With

                '4.2.3. Wykres 2
                ActiveSheet.Shapes.Range(Array("Picture" & " " & i * 2)).Select 'wykres w formacie obrazu w Excel'u
                Selection.Copy
                .Shapes.Paste
                Set WykresPP = .Shapes(SlajdPP.Shapes.Count)

                '4.2.4. Pozycjonowanie wykresu na slajdzie
                With WykresPP
                    .Left = 40
                    .Top = 315
                    .LockAspectRatio = msoFalse 'odblokowanie wsp. proporcji
                    .Width = 400
                    .Height = 195
                End With

            '4.3. Doddanie statystyk

                '4.3.1. Wyznaczenie numeru pierwszego wiersza dla danej marki
                Wiersz = NrWiersza + 3 + 25 * (i - 1)

                '4.3.2 Wczytanie statystyk
                Tekst = Cells(Wiersz, 2) & " " & Cells(Wiersz, 3) & vbNewLine & _
                    Cells(Wiersz + 20, 2) & " " & FormatNumber(Cells(Wiersz + 20, 4), 2) & vbNewLine & _
                    Cells(iersz + 21, 2) & " " & Cells(iersz + 21, 4) & vbNewLine & _
                    Cells(Wiersz + 22, 2) & " " & Cells(Wiersz + 22, 4) & vbNewLine & _
                    Cells(Wiersz + 22, 2) & " " & Cells(Wiersz + 22, 4) & vbNewLine & _
                    vbNewLine & _
                    Cells(Wiersz + 20, 6) & " " & FormatNumber(Cells(Wiersz + 20, 9), 2) & vbNewLine & _
                    Cells(Wiersz + 21, 6) & " " & Cells(Wiersz + 21, 9) & vbNewLine & _
                    Cells(Wiersz + 22, 6) & " " & Cells(Wiersz + 22, 9) & vbNewLine & _
                    vbNewLine & _
                    Cells(Wiersz + 20, 11) & " " & Cells(Wiersz + 20, 13) & vbNewLine & _
                    Cells(Wiersz + 21, 11) & " " & Cells(Wiersz + 21, 13)

                '4.3.3. Pozycjonowanie pola
                .Shapes(2).Top = 110
                .Shapes(2).Left = 500
                .Shapes(2).Width = 330
                .Shapes(2).Height = 410
                .Shapes(2).TextFrame.TextRange = Tekst

        End With
        Next i

        '4.4. Stworzenie slajdu końcowego

            '4.4.1. Dodanie slajdu
            Set SlajdPP = PowerPointA.Presentations(1).Slides.Add _
                (PowerPointA.Presentations(1).Slides.Count + 1, ppLayoutText)
            SlajdPP.Shapes(1).Delete

            '4.4.2. Uzupełnienie slajdu
            With SlajdPP.Shapes(1)
                .TextFrame.TextRange = "DZIĘKUJĘ ZA UWAGĘ"
                .TextFrame.HorizontalAnchor = msoAnchorCenter
                .TextFrame.VerticalAnchor = msoAnchorMiddle
                .TextEffect.FontBold = msoCTrue
                .TextEffect.FontSize = 24
                .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 100, 170)
            End With

        End With

        '5. Zapisanie prezentacji PowerPoint
        PrezentacjaPP.SaveAs Excel.ActiveWorkbook.Path & "\Prezentacja_PP_" & Date & ".pptx"

    Application.ScreenUpdating = True 'Włącz odświeżanie ekranu

End Sub
4

1 回答 1

4

后期绑定意味着 VBA 仅具有所涉及类型的运行时知识。这是后期绑定：

Dim PowerPointA As Object

PowerPoint该声明将在有或没有引用的类型库的情况下编译。

因为 VBA 不（不能）知道成员PowerPointA有什么，所以你在设计时不会得到IntelliSense，这会很高兴地编译......

PowerPointA.SomeMemberThatDoesNotExist

...并在运行时出现错误 438“对象不支持此属性或方法”。

任何反对Object或Variant迟到的会员电话；在运行时，VBA 需要查询接口以定位成员并确定其存在：这意味着后期绑定代码会产生一些早期绑定代码不需要的开销。

早期绑定意味着 VBA 具有所涉及类型的编译时知识。这是早期绑定：

Dim PowerPointA As PowerPoint.Application

PowerPoint只有在引用类型库时，该声明才能编译。

因为 VBA 知道成员PowerPointA有什么，所以您在设计时获得IntelliSense（和自动完成），这不应该编译 ：

PowerPointA.SomeMemberThatDoesNotExist

...但是Application很可能是一个可扩展的COM 接口（Excel.Application是）；如果是这种情况，那么 VBA 将编译代码，并且SomeMemberThatDoesNotExist将是一个后期绑定的成员调用，它将在运行时出现错误 438“对象不支持此属性或方法”。

当您想“将早期绑定代码转换为后期绑定代码”时，您真正的意思是您想从项目中删除类型库引用，并且仍然能够编译和运行代码。

假设引用是PowerPoint类型库，这意味着您需要替换代码中定义在此库中的所有内容 - 因为一旦删除引用，诸如 、 和 之类的类PowerPoint.Application将不再被定义PowerPoint.Presentation，并且不再具有任何意义VBA。所以：PowerPoint.SlidePowerPoint.Shape

  1. 将声明替换As [PowerPoint.][ClassName]为As Object
  2. 替换New [PowerPoint.][ClassName]为CreateObject("ProgIdForThatClass")
  3. 移除对PowerPoint类型库的引用
  4. 编译项目。不编译？回到 1。

ProgIdforPowerPoint.Application恰好是，因此"PowerPoint.Application"您可以替换它：

Set PowerPointA = New PowerPoint.Application

有了这个：

Set PowerPointA = CreateObject("PowerPoint.Application")

这就是你需要做的。

如果您在其他地方有引用PowerPoint类型库中定义的常量的代码，您需要将它们替换为它们的基础值，或者自己定义等效常量，所以不要这样：

foo = ppEffectFade

你会有这个：

foo = 1793 'PowerPoint.PpEntryEffect.ppEffectFade=1793

或这个：

Const ppEffectFade As Long = 1793

foo = ppEffectFade

或这个：

Public Enum PpEntryEffect
    ppEffectAppear = 3844
    ppEffetFade = 1793
    '...
End Enum

foo = ppEffectFade

您可以使用对象浏览器( )定位所有常量、它们的值以及在任何引用类型库中定义的所有内容F2：

显示 PowerPoint.PpEntryEffect.ppEffectAppear 定义的对象浏览器

于 2018-05-11T14:41:38.780 回答