Solved: Save As powerpoint that reference a cell in Excel

[Shazam]

Hello,

I'm trying to do a Save As in PowerPoint that reference a cell in Excel.

This what I got so far.


Dim PPApp As PowerPoint.Application

tCell = Sheets("Table").Range("L1").Value

PPApp.ActivePresentation.SaveAs ("Z:\Performance\" & tCell & ".ppt")



But it gives me a debugger:

object variable or with block variable not set.
Run-time error '91':

Does anyone has any ideas how to accomplish this?

[mdmackillop]

'Requires a reference to Microsoft Excel
Sub test()
'Final term is the R1C1 address of the required cell
ActivePresentation.SaveAs GetData("C:\AAA\", "Book1.xls", "sheet1", "R1C1") & ".ppt"
End Sub


Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Dim appXL As Excel.Application
Set appXL = New Excel.Application
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & Address
GetData = appXL.ExecuteExcel4Macro(Data)
Set appXL = Nothing
End Function

[Shazam]

'Requires a reference to Microsoft Excel
Sub test()
'Final term is the R1C1 address of the required cell
ActivePresentation.SaveAs GetData("C:\AAA\", "Book1.xls", "sheet1", "R1C1") & ".ppt"
End Sub


Private Function GetData(Path, File, Sheet, Address)
Dim Data$
Dim appXL As Excel.Application
Set appXL = New Excel.Application
Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & Address
GetData = appXL.ExecuteExcel4Macro(Data)
Set appXL = Nothing
End Function


Hi mdmackillop,


Very slick code thank you very much. But I should've been more detail.

I have both Excel & PowerPoint open. Can I run a macro from Excel to do a Save As on the Powerpoint that points to a cell reference (say: L1 ) on the currently active Excel workbook that I have open?

Like:

'Active workbook that is open
tCell = Sheets("Table").Range("L1").Value

PPApp.ActivePresentation.SaveAs ("Z:\Performance\" & tCell & ".ppt")

[geekgirlau]

Sub Test()
' requires a reference to PPT object library
Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim tCell As String


On Error Resume Next
Set PPApp = GetObject("", "PowerPoint.Application")

If Err.Number <> 0 Then
MsgBox "Cannot connect to PowerPoint!" & vbCrLf & vbCrLf & _
"Make sure your presentation is currently open.", vbExclamation, _
"PowerPoint Not Found"
Else
' additional error checking to ensure a presentation is open
Set PPPres = PPApp.ActivePresentation

If Err.Number <> 0 Then
MsgBox "Cannot connect to PowerPoint!" & vbCrLf & vbCrLf & _
"Make sure your presentation is open.", vbExclamation, _
"PowerPoint Not Found"
Else
On Error GoTo ErrHandler

'Active workbook that is open
tCell = Sheets("Table").Range("L1").Value

If tCell = "" Then
MsgBox "Invalid name - cannot save Presentation", vbInformation, _
"Invalid Filename"
Else
PPApp.ActivePresentation.SaveAs ("Z:\Performance\" & tCell & ".ppt")
End If
End If
End If

ExitHere:
On Error Resume Next
Set PPPres = Nothing
Set PPApp = Nothing
Exit Sub

ErrHandler:
MsgBox Err.Description, vbCritical, "Unexpected Error: " & Err.Number
Resume ExitHere
End Sub

[Shazam]

Thank You geekgirlau it works perfect.