从没有参考的excel添加PowerPoint幻灯片

Question

早上好，

我有一个 excel 文件，从中可以在 powerpoint 中创建幻灯片。为此，我使用了 vba，一切都使用对 PowerPoint 对象的引用。

但是，这个文件应该在不同版本的 Office 的多台机器上使用，所以我不能使用引用。 我在“Set pptLayout = Presentazione.Slides (1) .CustomLayout”行有错误：运行时错误 438

我该如何解决？

有没有一种方法可以添加空白幻灯片 A4 尺寸而不是使用 ppCustomLayout ???

Option Explicit
'Public PPSlide As Slide
'Public Plate As Variant
Public PlatesOnSheet, Sheet As Single
Public TextOfPlate As String
Public Copies, HowMuch, RowNumber, LastRow As Integer
'Public PPPresentation As PowerPoint.Presentation
'Public pptLayout As CustomLayout
Public PlateHeight As Single
Public PPPresentation, PPSlide, Plate, pptLayout, PowerPointApp As Object

Public Sub Plates()
Set PowerPointApp = CreateObject("PowerPoint.Application")
PowerPointApp.Visible = True

Set PPPresentation = PowerPointApp.Presentations.Open("P:\Per Officina\DA E PER MASSIMO G\Plates MT\NUOVA\Plates mt.pptm", msoTrue)
Set pptLayout = PPPresentation.Slides(1).CustomLayout
Sheet = 1
PlatesOnSheet = 0
PlateHeight = 35
LastRow = 27
While Cells(LastRow, 2) <> "totale"
    LastRow = LastRow + 1
Wend
LastRow = LastRow - 2
For RowNumber = 2 To LastRow
    TextOfPlate = Cells(RowNumber, 1)
    If Cells(RowNumber, 2) = "" Then
        Copies = 0
    Else
        Copies = Cells(RowNumber, 2)
    End If
    If Copies = 0 Then GoTo SaltaTextOfPlate:
    For HowMuch = 1 To Copies
        If PlatesOnSheet < 5 Then
            Call CreatePlate
        Else
            PlatesOnSheet = 0
            PPPresentation.Slides.AddSlide Index:=Sheet + 1, pcustomlayout:=pptLayout
            Sheet = Sheet + 1
            PlateHeight = 35
            Call CreatePlate
        End If
    Next
SaltaTextOfPlate:
Next
If PlatesOnSheet < 5 Then
    Copies = 5 - PlatesOnSheet
    TextOfPlate = Application.InputBox(Copies & " blank plates remain: complete with?")
    For HowMuch = 1 To Copies
        Call CreatePlate
    Next
End If
End Sub

Public Sub CreatePlate()
Set PPSlide = PPPresentation.Slides(Sheet)
Set Plate = PPSlide.Shapes.AddShape(Type:=msoShapeRectangle, Left:=61, Top:=PlateHeight, Width:=428.0315, Height:=144.5669)
With Plate.TextFrame.TextRange
    .Text = TextOfPlate
    .Font.Bold = True
    .Font.Name = "Arial Narrow"
    .Font.Size = 36
    .Paragraphs.ParagraphFormat.Alignment = 2
End With
Plate.Line.Visible = True
Plate.Fill.ForeColor.RGB = RGB(255, 255, 255)
Plate.TextFrame2.VerticalAnchor = msoAnchorMiddle
PlatesOnSheet = PlatesOnSheet + 1
PlateHeight = PlateHeight + 144.5669
End Sub

Answer 1

每当您在 VBA 中声明变量时，都必须将每个变量显式声明为一种类型。在行尾使用单个类型声明的逗号分隔不能按预期工作。例如这一行：

Public Copies、HowMuch、RowNumber、LastRow As Integer

将前三个变量声明为 Variant（因为没有指定类型），只有最后一个是 Integer。如果它们都是整数类型，你必须这样做：

Public Copies 为整数、HowMuch 为整数、RowNumber 为整数、LastRow 为整数

使用后期绑定：

1. 将所有 PowerPoint 对象声明为 Object 类型
2. 从您的项目中删除 PowerPoitn 库引用

请注意，这样做会失去 VBA 的 IntelliSense 功能，因此请在所有调试完成后进行。

您当然可以使用条件编译器常量来编写同时支持早期绑定和后期绑定的代码，例如

' Change to False and remove PowerPoint reference for Late Binding
#Const EarlyBinding = True

#If EarlyBinding Then
  Public PPPresentation As PowerPoint.Presentation
  Public PPSlide As PowerPoint.Slide
  ' etc.
#Else
  Public PPPresentation As Object
  Public PPSlide As Object
  ' etc.
#End If

Answer 2

我用这段代码解决了：

Option Explicit
Public PlatesOnSheet, Sheet As Single
Public TextOfPlate As String
Public Copies, HowMuch, RowNumber, LastRow As Integer
Public pptLayout
Public PlateHeight As Single
Public PPPresentation, PPSlide, Plate, PowerPointApp As Object

Public Sub Plates()
Set PowerPointApp = CreateObject("PowerPoint.Application")
PowerPointApp.Visible = True

Set PPPresentation = PowerPointApp.Presentations.Open("P:\Per Officina\DA E PER MASSIMO G\TARGHE MT\NUOVA\targhe mt.pptm", msoTrue)
Sheet = 1
PlatesOnSheet = 0
PlateHeight = 35
LastRow = 27
While Cells(LastRow, 2) <> "TOTALE"
    LastRow = LastRow + 1
Wend
LastRow = LastRow - 2
For RowNumber = 2 To LastRow
    TextOfPlate = Cells(RowNumber, 1)
    If Cells(RowNumber, 2) = "" Then
        Copies = 0
    Else
        Copies = Cells(RowNumber, 2)
    End If
    If Copies = 0 Then GoTo SaltaTextOfPlate:
    For HowMuch = 1 To Copies
        If PlatesOnSheet < 5 Then
        Set PPSlide = PPPresentation.Slides(Sheet)
            Call CreatePlate
        Else
            PlatesOnSheet = 0
            Set PPSlide = PPPresentation.Slides.Add(Sheet + 1, 12)
            Sheet = Sheet + 1
            PlateHeight = 35
            Call CreatePlate
        End If
    Next
SaltaTextOfPlate:
Next
If PlatesOnSheet < 5 Then
    Copies = 5 - PlatesOnSheet
    TextOfPlate = Application.InputBox(Copies & " blank plates remain: complete with?")
    For HowMuch = 1 To Copies
        Call CreatePlate
    Next
End If
End Sub

Public Sub CreatePlate()

Set Plate = PPSlide.Shapes.AddShape(Type:=msoShapeRectangle, Left:=61, Top:=PlateHeight, Width:=428.0315, Height:=144.5669)
With Plate.TextFrame.TextRange
    .Text = TextOfPlate
    .Font.Bold = True
    .Font.Name = "Arial Narrow"
    .Font.Size = 36
    .Paragraphs.ParagraphFormat.Alignment = 2
End With
Plate.Line.Visible = True
Plate.Fill.ForeColor.RGB = RGB(255, 255, 255)
If Application.Version <> "11.0" Then Plate.TextFrame2.VerticalAnchor = 3
PlatesOnSheet = PlatesOnSheet + 1
PlateHeight = PlateHeight + 144.5669
End Sub