Rewrite of the PowerPoint UDF

[water]

Thanks for your post.
At the moment I try to get my head around how the object model of PPT looks like. A big picture / overview of the objects/collections and their relation.
Then I will dive in and work with frames, shapes, themes etc.

[junkew]

• Combine it / make some functions for VISIO at the same time
  especially when you make automated flowcharts from text its nice if you can have similar functions for visio and powerpoint.
• Make clear when you just use $oPPT_App= createobject("powerpoint.application") and when to use the udf
  Is it just an abstraction UDF or does it add power over the already accessible powerpoint application
   

 

[water]

Junkew,

thanks for your post!

• I think Visio needs an UDF on its own. Some features might be similar but I think it is not sensible to mix PowerPoint and Visio
• The PowerPoint UDF adds some "power" by doing error handling, setting sensible defaults and wrapping complex operations.
  _PPT_Open tries to connect to an already running instance of PowerPoint. If none exists it starts PowerPoint.

[junkew]

ok when I have time enough I will follow PPT udf and make similar one for VISIO

 

[water]

Great  

[water]

New Alpha 3 version of the UDF released.
Added function _PPT_PresentationExport: Export the whole or parts of the presentation as PDF or XPS.

[water]

Anyone interested in a function to export slide(s) as graphics (JPG, GIF, PNG ...)?

[UEZ]

Sure.

[water]

Fine. I'm about to write the function.

You are the graphics guru:
For exporting slides you can specify the width and/or height. The function provides a flag to preserve the width/height ratio.
If the user specifies width and height but with this values the ratio would not be preserved how would you calculate the new with/height to preserve the ratio?
Only use width and ignore height? Calculate if width or height exceed the ratio and use this value to calculte the other value? Something else?

[UEZ]

I would use the width value to calculate the height value according to the ratio.

Or you can be more flexible if either width or height is zero then the other value will be calculated accordingly.

[water]

New Alpha 4 version of the UDF released.
For details please check the download section of this forum.

[UEZ]

If folder Presentation1 is not extisting then the script will fail to create the PNGs.

[water]

Thanks for the feedback!
The function will create the directory now. Will be part of the next alpha.
 

expandcollapse popup

; #FUNCTION# ====================================================================================================================
; Name...........: _PPT_PresentationExportGraphic
; Description ...: Export one/multiple/all slides of a presentation in a graphic format.
; Syntax.........: _PPT_PresentationExportGraphic($oPresentation[, $sPath = @ScriptDir[, $sSlide = Default[, $sFilter = "JPG"[, $bKeepRatio = True]]]])
; Parameters ....: $oPresentation - Presentation object.
;                  $sPath         - [optional] Directory where the graphics should be stored. The graphics are named Slide<n>. n is the slide number (default = keyword Default = @ScriptDir).
;                  $sSlide        - [optional] A string with the index number of the starting (and ending) slide to be exported (, separated by a hyphen) (default = Keyword Default = export all slides in the presentation).
;                  $sFilter       - [optional] The graphics format in which you want to export slides (default = JPG). See Remarks.
;                  $iScaleWidth   - [optional] The width in pixels of an exported slide (default = keyword Default = do not change the width).
;                  $iScaleHeight  - [optional] The height in pixels of an exported slide (default = keyword Default = do not change the heigth).
;                  $bKeepRatio    - [optional] If set To True the width:height ratio is preserved (default = True)
; Return values .: Success - 1.
;                  Failure - 0 and sets @error.
;                  |1 - $oPresentation is not an object or not a presentation object
;                  |2 - $sSlide is an object but not a sliderange object
;                  |3 - $sPath didn't exist and returned an error when the function tried to create it.
;                  |4 - Error occurred when exporting the presentation. @extended is set to the COM error code returned by the ExportAsFixedFormat method
;                  |5 - $sSlide is invalid. Has to be "StartingSlide-EndingSlide"
; Author ........: water
; Modified.......:
; Remarks .......: This function only supports a single range of consecutive slides.
;                  The specified graphics format must have an export filter registered in the Windows registry.
;                  You need to specify the registered extension (JPG, GIF etc.).
; Related .......:
; Link ..........:
; Example .......: Yes
; ===============================================================================================================================
Func _PPT_PresentationExportGraphic($oPresentation, $sPath = Default, $sSlide = Default, $sFilter = Default, $iScaleWidth = Default, $iScaleHeight = Default, $bKeepRatio = Default)
    Local $iStartingSlide, $iEndingSlide
    If Not IsObj($oPresentation) Or ObjName($oPresentation, 1) <> "_Presentation" Then Return SetError(1, 0, 0)
    If $sSlide = Default Then
        $iStartingSlide = 1
        $iEndingSlide = $oPresentation.Slides.Count
    Else
        Local $aSlides = StringSplit($sSlide, "-", $STR_NOCOUNT)
        Local $iValues = UBound($aSlides)
        If $iValues < 1 Or $iValues > 2 Then
            Return SetError(5, 0, 0)
        ElseIf $iValues = 1 Then
            ReDim $aSlides[2]
            $aSlides[1] = $aSlides[0]
        EndIf
        If Number($aSlides[0]) = 0 Or Number($aSlides[1]) = 0 Then Return SetError(5, 0, 0)
        $iStartingSlide = $aSlides[0]
        $iEndingSlide = $aSlides[1]
    EndIf
    If $sPath = Default Then $sPath = @ScriptDir
    If Not FileExists($sPath) Then
        If DirCreate($sPath) = 0 Then Return SetError(3, 0, 0)
    Endif
    If $sFilter = Default Then $sFilter = "JPG"
    If $bKeepRatio = Default Then $bKeepRatio = True
    If $bKeepRatio = True And ($iScaleWidth <> Default Or $iScaleHeight <> Default) Then
        Local $iRatio = $oPresentation.Pagesetup.SlideWidth / $oPresentation.Pagesetup.SlideHeight
        If $iScaleWidth = Default Then
            $iScaleWidth = $oPresentation.Pagesetup.SlideWidth * ($iScaleHeight / $oPresentation.Pagesetup.SlideHeight)
        Else
            $iScaleHeight = $oPresentation.Pagesetup.SlideHeight * ($iScaleWidth / $oPresentation.Pagesetup.SlideWidth)
        EndIf
    EndIf
    For $i = $iStartingSlide To $iEndingSlide
        $oPresentation.Slides($i).Export($sPath & "\Slide" & $i & "." & $sFilter, $sFilter, $iScaleWidth, $iScaleHeight)
        If @error Then Return SetError(4, @error, 0)
    Next
    Return 1
EndFunc   ;==>_PPT_PresentationExportGraphic

 

Edited December 9, 2015 by water

[water]

The Word and Excel object model allow to set the active printer. So the UDF print functions allow to print the document/workbook on every possible printer.
In the PowerPoint object model this features is missing.
Should the PowerPoint UDF should use another way (WSH etc.) to set the active printer so the print function is similar to the Word/Excel UDF?

 

[drquochoai]

Thanks water a lot, your UDF is so cool.

Please add some more function about VBA Macros please!

Example:

•  _PPT_PresentationMacrosAdd : add new macros to current presentation
•  _PPT_PresentationMacrosDelete : delete one or more macros from current presentation
•  _PPT_PresentationMacrosRun : run a macros from text in autoit.

Edited January 5, 2016 by drquochoai

[water]

Glad you like the alpha version of the UDF

Running a PPT macro is a one-liner. A UDF function should be a wrapper to hide complexity. So, like in all other UDFs, a _PPT_MacroRun function will not be implemented.
It is easy to code it yourself as described here: https://msdn.microsoft.com/en-us/library/ff744221(v=office.14).aspx

$oPPT.Run("Name of the macro to run")

Adding/Deleting a macro is a different game and needs to call the VBE (Visual Basic Editor): https://msdn.microsoft.com/en-us/library/ff744221(v=office.14).aspx
The UDF will focus on often used and basic PowerPoint functions. So I fear that VBE is out of scope as well.
But if enough people long for a VBE UDF - who knows?

 

[drquochoai]

Thanks water so much for quick reply.

I've read the microsoft document from your link https://msdn.microsoft.com/en-us/library/ff744221(v=office.14).aspx

Actually i need to add one same VBA code to a lot of presentations (the code to check if there are missing fonts in all ppt files):

expandcollapse popup

Option Base 1
Sub MissingFonts()
Dim sfont As Long
Dim PresFonts() As String, MissingFonts() As String
Dim NumFontsInPres As Integer
Dim FontInstalled As Boolean, FontMissing As Boolean
NumFontsInPres = ActivePresentation.Fonts.Count
ReDim PresFonts(CInt(NumFontsInPres))
  For i = 1 To NumFontsInPres
    PresFonts(i) = ActivePresentation.Fonts(i).Name
  Next i
  Set wordapp = CreateObject("Word.document")
  With wordapp
    .Application.Visible = False
    .Parent.System.cursor = wdCursorWait
    For i = 1 To NumFontsInPres
      For Each FontName In wordapp.Application.FontNames
        If FontName = PresFonts(i) Then
          FontInstalled = True
        End If
      Next FontName
      If FontInstalled = False Then
        On Error GoTo FirstFoundMissingFont
        MissFontSize = UBound(MissingFonts())
        GoTo NoError
FirstFoundMissingFont:
        MissFontSize = 0
NoError:
        ReDim Preserve MissingFonts(CInt(MissFontSize + 1))
        MissingFonts(CInt(MissFontSize + 1)) = PresFonts(i)
      End If
    Next i
    .Parent.System.cursor = wdCursorNormal
    .Application.Quit
  End With
  Set wordapp = Nothing
  On Error GoTo EmptyArray
  If LBound(MissingFonts) = UBound(MissingFonts) Then GoTo FullArray
EmptyArray:
  MsgBox "All fonts are installed"
  Exit Sub
FullArray:
  For j = 1 To UBound(MissingFonts)
    FontList$ = MissingFonts(j) + vbCr
  Next j
  MsgBox "The following fonts are missing:" + vbCr + FontList$
End Sub

But i really don't know how, because the .Run function will call the added Macros, but not auto add a new macros.

$oPPT.Run("Name of the macro to run")
; .Run(MacroName, safeArrayOfParams)

I'm so happy if you point me the way how i could do it by myself.

 

 

[water]

Is this a one-off job?

[water]

Simple example to process all presentations in the script directory and write missing font names to the Console:

#include <PowerPoint.au3>
#include <Word.au3>
#include <File.au3>

Global $oPPT = _PPT_Open(False)
Global $oWord = _Word_Create(False)
Global $oWordFonts = $oWord.Application.FontNames
; .Parent.System.cursor = wdCursorWait
; .Parent.System.cursor = wdCursorNormal
; Get a list of all PPT files
$aPPT = _FileListToArray(@ScriptDir, "*.PPTX", $FLTA_FILES, True)
If @error Then Exit MsgBox($MB_ICONERROR, "Error", "No PPT-files could be found!")
For $i = 1 To $aPPT[0]
;   ConsoleWrite("Processing: " & $aPPT[$i] & @CRLF)
    $oPres = _PPT_PresentationOpen($oPPT, $aPPT[$i], Default, False)
    _ProcessPresentation($oPres)
    _PPT_PresentationClose($oPres)
Next
_Word_Quit($oWord)
_PPT_Close($oPPT)
Exit

Func _ProcessPresentation($oPres)
    Local $bFound
    For $oPPTFont In $oPres.Fonts
;       ConsoleWrite("  Processing Font: " & $oPPTFont.Name & @CRLF)
        $bFound = False
        For $oWordFont In $oWordFonts
            If $oPPTFont.Name = $oWordFont Then
                $bFound = True
                ExitLoop
            EndIf
        Next
        If $bFound = False Then ConsoleWrite("Presentation: " & $oPres.FullName & ", Font: " & $oPPTFont.Name & " is missing." & @CRLF)
    Next
EndFunc   ;==>_ProcessPresentation

 

Edited January 6, 2016 by water

[water]

New Alpha 5 version of the UDF released.
For details please check the download section of this forum.