有没有办法在PowerPoint中导入多页PDF?

时间:2019-09-12 17:40:13

标签: vba powerpoint powerpoint-vba

我每天需要将14个pdf文件导入powerpoint进行日常会议。我已经使用VBA成功导入了PDF,但是它仅导入了第一页。我的一些PDF会有多页。

所有pdf文件都是从访问数据库中生成的,因此必须采用pdf格式,因为它们也会发送给其他位置的人。简报仅适用于我们的团队。

Public Function Import_Reports()
Dim shp As Shape
Dim sld As Slide
Dim fpath As String
Dim fname As String
Dim strFileSpec As String
Dim PotentialDate As Long
Dim Free As Boolean
Dim sldCount As Integer

sldCount = 1
fpath = "K:\Dept\Erie-Eng\Erie\ZSPEC\application engineering\Zurn Application Engineering Project Management\Gemba Files\" & Format(Now, "yyyy") & "\" & Format(Now, "yyyy_mm") & "\"

PotentialDate = Format(Date, "0,###.0000") - 1
'MsgBox fpath & Format(PotentialDate, "yyyy_mm_dd")
Do Until Free = True
    If Len(Dir(fpath & Format(PotentialDate, "yyyy_mm_dd"), vbDirectory)) = 0 Then
        PotentialDate = DateAdd("d", -1, PotentialDate)
        'MsgBox fpath & Format(PotentialDate, "yyyy_mm_dd")
    Else
        Free = True
        fpath = fpath & Format(PotentialDate, "yyyy_mm_dd") & "\"
    End If
Loop

strFileSpec = fpath & "*.pdf*"
'MsgBox strFileSpec
fname = Dir(strFileSpec, vbDirectory)
'MsgBox fname
Do While Len(fname) > 0
On Error GoTo mkslide

Set sld = ActivePresentation.Slides(sldCount)
Set shp = sld.Shapes.AddOLEObject(0, 0, 11# * 72, 8.5 * 72, , fpath & fname, msoFalse, , , , msoFalse)
fname = Dir
sldCount = sldCount + 1
Loop
Exit Function
mkslide:
Set sld = ActivePresentation.Slides.AddSlide(ActivePresentation.Slides.Count + 1, ActivePresentation.Slides(1).CustomLayout)
Resume Next
End Function

我需要能够提取其他pdf页面,并将它们分别插入自己的幻灯片中。

0 个答案:

没有答案