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,. (https://bsdbrawl.net/)"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.