Save current slide only, no embedded fonts

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:

Code:

---

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

---

The code follows.

Thanks in advance for your help!

Code:

---

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

---

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

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

Code:

---

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

---

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

Quote:

---

Originally Posted by 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:

Code:

---

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

---

The code follows.

Thanks in advance for your help!

Code:

---

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.

Code:

---

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.

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.