Откройте PowerPoint через Excel VBA

Question

Я хочу открыть свой файл PowerPoint через Excel VBA, указав только расширение файла (.pptx). Я видел некоторые коды, но они требуют полного имени файла, который будет дан. Можно ли это сделать? Я храню только один файл PowerPoint в своей папке.

Answer 1

Вы можете сделать что-то вроде этого:

Sub Open_PPT()

    Dim PPTpath As String
    Dim PPTname As String

    Dim ThisExtension As String
    Dim temp As Variant

    temp = Split(ThisWorkbook.Name, ".")
    ThisExtension = temp(UBound(temp))

    PPTpath = Replace(ThisWorkbook.FullName, ThisExtension, "pptx")
    PPTname = Replace(ThisWorkbook.Name, ThisExtension, "pptx")

    Dim PPT As Object, PPPres As Object
    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Visible = True

    PPT.Presentations.Open FileName:=PPTpath
    Set PPPres = PPT.Presentations(PPTname)
    'open PPT

    PPPres.Slides(1).Select
End Sub

Я беру Имя книги и делю на "."и найдите последний элемент сгенерированного массива - скорее всего, «xlsx». Затем замените его на «pptx», чтобы у нас был полный путь, например:

«C: \ Users \ name \ Documents \ Excel_name.pptx»

и имя файла, например «Excel_name». .pptx ", тогда мы можем создать объект приложения PPT и открыть файл (я предполагаю, что он существует, в противном случае вам нужно открыть новый пустой PPT и сохранить его соответствующим образом)

Если ваш вопрос больше похож на" можноЯ нахожу файл .pptx с любым именем в той же папке, что и текущая папка (в которой сохранен Excel). "Затем вы ищете что-то вроде:

Sub Find_and_open_PPT()

    On Error Resume Next

    Dim FSO As Object, fld As Object
    Dim fileExtn As String
    Dim PPTpath As String
    Dim PPTname As String

    fileExtn = ".pptx"

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set fsoFolder = FSO.GetFolder(ThisWorkbook.Path)

    For Each fsoFile In fsoFolder.Files 'check the files in the parent folder
        If Err.Number > 0 Then
            'MsgBox "error handling file, likely due to permission"
            Err.Clear
        End If
        If Right(fsoFile, Len(fileExtn)) = fileExtn Then
            'PPT found
            PPTpath = fsoFile
            PPTname = fsoFile.Name
            Exit For
        End If
    Next        

    Dim PPT As Object, PPPres As Object
    Set PPT = CreateObject("PowerPoint.Application")
    PPT.Visible = True

    PPT.Presentations.Open FileName:=PPTpath
    Set PPPres = PPT.Presentations(PPTname)
    'open PPT

    PPPres.Slides(1).Select        

End Sub

Вы также можете изменить это, чтобы найти точноимя файла, которое вы ищете, или даже файл UNIX совпадают с чем-то вроде:

if fsoFile.Name like "example*.ppt*" then

В настоящее время код перестает искать, когда вы найдете файл с расширением ".pptx":

If Right(fsoFile, Len(fileExtn)) = fileExtn Then