Consulting

Results 1 to 4 of 4

Thread: Save current slide only, no embedded fonts

  1. #1

    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:

    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

  2. #2
    VBAX Master
    Joined
    Feb 2007
    Posts
    2,043
    Location
    A. Please declare your variables this makes it easier for you and everyone reading this.
    B tPath needs to be .Path & ""
    John Wilson
    Microsoft PowerPoint MVP
    Amazing Free PowerPoint Tutorials
    http://www.pptalchemy.co.uk/powerpoi...tutorials.html

  3. #3
    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

  4. #4
    VBAX Newbie
    Joined
    Feb 2022
    Posts
    1
    Location
    Quote Originally Posted by juanbolas View Post
    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.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •