Save current slide only, no embedded fonts

[juanbolas]

Hi all,

Me again. I wrote the following routine to save the current slide individually. When I used the export method it worked but it embedded the fonts so I went this route.

However it's giving me an error in the core line:

ActivePresentation.SaveAs FileName:=tFilename, _
FileFormat:=ppSaveAsPresentation, EmbedTrueTypeFonts:=msoFalse

The code follows.

Thanks in advance for your help!

    Sub SaveCurrentSlide()    CurrentSlide = ActiveWindow.View.Slide.SlideIndex
    MsgBox "The slide index of the current slide is:" & CurrentSlide


    On Error GoTo errorhandler


    If ActiveWindow.ViewType = ppViewNormal Then ActiveWindow.Panes(1).Activate


    With ActivePresentation
        ' Build a unique filename and save a coy of the now single-slide presentation
        tPath = .Path
        tFilename = tPath & Left(.Name, InStrRev(.Name, ".") - 1) & " [slide " & CurrentSlide & "].pptx"
        ActivePresentation.SaveAs FileName:=tFilename, _
        FileFormat:=ppSaveAsPresentation, EmbedTrueTypeFonts:=msoFalse
    End With
    
    ' Give feedback to the user
    MsgBox "Current slide exported to:" & tPath & tFilename, vbQuestion, vbOKOnly, "Export Current Slide - Export Complete"
    
    On Error GoTo 0
    Exit Sub
 
errorhandler:
      Debug.Print Err, Err.Description
      Resume Next
    End Sub

[John Wilson]

A. Please declare your variables this makes it easier for you and everyone reading this.
B tPath needs to be .Path & ""

[juanbolas]

My nad:

Here is the corrected code as per your request John.
I think the problem narrows down to the path. It seems use a Onedrive path as the current folder's bath which get's jumbled up with the rest of the path I add. I can't find the file at the location it says it saved the file.

Your thougts?

Thanks again

Option Explicit    
Sub SaveCurrentSlide()
Dim CurrentSlide As String
Dim tPath As String
Dim tFilename As String
CurrentSlide = ActiveWindow.View.Slide.SlideIndex
On Error GoTo errorhandler
If ActiveWindow.ViewType = ppViewNormal Then ActiveWindow.Panes(1).Activate
With ActivePresentation
     ' Build a unique filename and save a coy of the now single-slide presentation
     tPath = .Path
     tFilename = tPath & "\" & Left(.Name, InStrRev(.Name, ".") - 1) & " [slide " & CurrentSlide & "].pptx"
    ActivePresentation.SaveAs FileName:=tFilename, _
    FileFormat:=ppSaveAsPresentation, EmbedTrueTypeFonts:=msoFalse
End With
 ' Give feedback to the user
MsgBox "Current slide exported to:" & vbNewLine & tFilename, vbOKOnly, "Export Current Slide - Export Complete"
On Error GoTo 0
Exit Sub
errorhandler:
Debug.Print Err, Err.Description
Resume Next
End Sub

Sub newdd()
    
End Sub

[gochi77]

My nad:

Here is the corrected code as per your request John.
I think the problem narrows down to the path. It seems use a Onedrive path as the current folder's bath which get's jumbled up with the rest of the path I add. I can't find the file at the location it says it saved the file.

Your thougts?

Thanks again

Option Explicit    
Sub SaveCurrentSlide()
Dim CurrentSlide As String
Dim tPath As String
Dim tFilename As String
CurrentSlide = ActiveWindow.View.Slide.SlideIndex
On Error GoTo errorhandler
If ActiveWindow.ViewType = ppViewNormal Then ActiveWindow.Panes(1).Activate
With ActivePresentation
' Build a unique filename and save a coy of the now single-slide presentation
 tPath = .Path
 tFilename = tPath & "\" & Left(.Name, InStrRev(.Name, ".") - 1) & " [slide " & CurrentSlide & "].pptx"
 ActivePresentation.SaveAs FileName:=tFilename, _
 FileFormat:=ppSaveAsPresentation, EmbedTrueTypeFonts:=msoFalse
End With
' Give feedback to the user
MsgBox "Current slide exported to:" & vbNewLine & tFilename, vbOKOnly, "Export Current Slide - Export Complete"
On Error GoTo 0
Exit Sub
errorhandler:
Debug.Print Err, Err.Description
Resume Next
End Sub

Sub newdd()
    
End Sub

Thank you for the code, keep share with us sir it will helpful for me.