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

[gochi77]

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

[highlighter]

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

You did well buddy! Here are some correction that might be helpful for you.

Sub SaveSlideWithoutFonts()
    Dim tFilename As String
    tFilename = "C:\path\to\your\file.pptx"  ' Change this to your desired path
    ' Save the presentation without embedding fonts
    With ActivePresentation
        ' Temporarily disable font embedding in the settings
        .EmbedTrueTypeFonts = msoFalse
        ' Save the presentation as a new file
        .SaveAs FileName:=tFilename, FileFormat:=ppSaveAsPresentation
    End With
End Sub

Try this if possible and let me know the results according to it. Thank you.

[cenat]

I ran into this issue too. What worked for me was creating a quick macro to copy just the current slide into a new presentation, then saving it without embedding the fonts. Super handy if you're just sharing one slide.