从excel添加powerpoint幻灯片而不引用

时间:2016-07-28 06:25:26

标签: excel vba powerpoint powerpoint-vba

早上好,

我有一个excel文件,可以在powerpoint中创建幻灯片。为此,我使用了vba,并且所有工作都使用了对PowerPoint对象的引用。

但是,此文件应该在具有不同版本的Office的多台计算机上使用,因此我无法使用引用。 我在“Set pptLayout = Presentazione.Slides(1).CustomLayout”行中出错:运行时错误438

我该如何解决?

是否有方法使用ppCustomLayout ???

添加空白幻灯片A4尺寸
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

2 个答案:

答案 0 :(得分:0)

每当在VBA中声明变量时,每个变量都必须显式声明为类型。通过逗号分隔行末尾的单个类型声明并不像您期望的那样工作。例如,这一行:

Public Copies,HowMuch,RowNumber,LastRow As Integer

将前三个变量声明为Variant(因为没有指定类型),只有最后一个变量为Integer。如果它们都是Integer类型,那么你必须这样做:

公共副本为整数,如何整数,RowNumber为整数,LastRow为整数

使用延迟绑定:

  1. 将所有PowerPoint对象声明为Object
  2. 类型
  3. 从项目中删除PowerPoitn库引用
  4. 请注意,通过执行此操作,您将失去VBA的智能感知功能,因此请在完成所有调试后执行此操作。

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

    ' 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
    

答案 1 :(得分:0)

我用这段代码解决了:

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