User:Smallman12q/powerpoint to gif

The following describes how to create an animated gif from a series of PowerPoint slides in PowerPoint 2003, 2007, 2010 in Windows. It requires you have GIMP installed.


 * PowerPoint
 * 1) Open the powerpoint presentation.
 * 2) Select "File" -> "Save As" (File being the large round office button)
 * 3) Either click on "Save As" or click on "Other Formats"
 * 4) Select where to save (this will save as a folder of images)
 * 5) Under "Save type as", select "GIF" and click Save


 * GIMP
 * 1) Open GIMP
 * 2) Select "File"->"Open As Layers"
 * 3) Navigate to the folder of images with down "Ctrl" and click to select several files, or click on a file and then hold "shift" and click on one further below to select those in between.
 * 4) Select "Open"...Gimp will now load the images.
 * 5) Select "File" -> "Export As"
 * 6) For the "Name", make sure it ends in ".gif" such as "example.gif" and click save
 * 7) An Export File Dialog will pop up:
 * 8) Another dialog will pop up:


 * 9. Hit Save and you're done.

PowerPoint resolution
You may need to adjust PowerPoint's resolution. Currently, this can only be done via the registry or an addon. You may adjust the image size in GIMP, but doing so is more lossy (less clear image). The following script will automate the change of the image resolution.


 * Instructions
 * 1) Open a plain text editor, such as notepad
 * 2) Copy and paste the code below into notepad
 * 3) In notepad, select File->Save as and select "All files" at "File Save as Type"
 * 4) Right click on PowerPoint.vbs in the directory and select "Open with command prompt". It should run. You should get a command prompt window (a black window) with output.
 * 5) It will ask you what to set the resolution to.

Source
'Author: Smallman12q (https://en.wikipedia.org/wiki/User:Smallman12q) 'Date: August 2012 '     It automates the procedure at http://support.microsoft.com/kb/827745

'force CScript execution Sub forceCScriptExecution Dim Arg, Str If Not LCase(Right(WScript.FullName, 12)) = "\cscript.exe" Then For Each Arg In WScript.Arguments If InStr(Arg, " ") Then Arg = """" & Arg & """" Str = Str & " " & Arg Next CreateObject("WScript.Shell").Run "cscript //nologo """ & WScript.ScriptFullName & """" & Str WScript.Quit End If End Sub forceCScriptExecution

' Create constants for access rights and registry hive Const KEY_QUERY_VALUE = &H0001 Const KEY_SET_VALUE = &H0002 Const HKEY_CURRENT_USER = &H80000001

'PowerPoint Options Registry Locations Const PowerPoint2003 = "HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\PowerPoint\Options\" Const PowerPoint2010 = "HKEY_CURRENT_USER\Software\Microsoft\Office\14.0\PowerPoint\Options\"

Dim objShell: Set objShell = CreateObject("WScript.Shell")

Dim strComputer: strComputer = "." Dim objReg: Set objReg=GetObject("winmgmts:"_   & "{impersonationLevel=impersonate}!\\" &_     strComputer & "\root\default:StdRegProv") Dim PowerPoint

'See if the key exists On Error Resume Next

Dim entry: entry = objShell.regRead(key) Select Case err.number case 0: keyExists = true case else: keyExists = false end Select err.clear end Function

'Check if you can read/write the key Function checkaccessrights(key) Dim bHasAccessRight objReg.CheckAccess HKEY_CURRENT_USER, Replace(key,"HKEY_CURRENT_USER\",""), _ KEY_QUERY_VALUE + KEY_SET_VALUE, bHasAccessRight checkaccessrights = bHasAccessRight End Function

'Set the dpi value Sub createdpi dpiexist 'Check if exists first Writeln "" Writeln "This will temporarily change the resolution of exported images from PowerPoint." Writeln "You may delete the change by running this script again." Writeln "The default is around 96 dpi (dots-per inch."   Writeln ""   	Writeln "dpi | Pixels (Horizontal x Vertical) Roughly"   	Writeln "|---"   	Writeln "  50| 500 x 375"   	Writeln "  96| 960 x 720"   	Writeln " 100| 1000 x 750"   	Writeln " 150| 1500 x 1125"   	Writeln " 200| 2000 x 1500"   	Writeln "============================================"   	Writeln "If you do not want to change the DPI, please close the console."   	WScript.StdOut.Write "Please enter DPI (and hit enter): "   	Dim dpi: dpi = WScript.StdIn.ReadLine   	dpi = Cint(dpi)

objReg.SetDWORDValue HKEY_CURRENT_USER, PowerPoint,"ExportBitmapResolution",dpi

Dim dwValue objReg.GetDWORDValue HKEY_CURRENT_USER,PowerPoint,"ExportBitmapResolution",dwValue If dwValue <> dpi Then Writeln "Error 3: Unable to determine if key value was created." Else Writeln "dpi successfully set to " & dpi & "." End If	quit End Sub

'Check if dpi exists Sub dpiexist Dim strValue objReg.GetDWORDValue HKEY_CURRENT_USER,PowerPoint,"ExportBitmapResolution",strValue If IsNull(strValue) Then Writeln "No prior dpi key found." Else Writeln "A dpi key with value of '" & strValue & "' already exists. Would you like to delete it?" Writeln "Type 'y' for yes, 'n' for no, (without ') and hit enter. If you set a value later, it will be overwritten." Dim delete: delete = WScript.StdIn.ReadLine 'WScript.StdIn.Read(1) If delete = "y" Then objReg.DeleteValue HKEY_CURRENT_USER,PowerPoint,"ExportBitmapResolution" Writeln "dpi key deleted." Else Writeln "dpi key not deleted." End If End If End Sub

Sub quit Writeln "Press 'enter' to quit." WScript.StdIn.ReadLine WScript.Quit End Sub

Sub PPset( PPversion, text) PowerPoint = Replace(PPversion,"HKEY_CURRENT_USER\","") Writeln text createdpi End Sub

Sub Writeln (text) WScript.StdOut.WriteLine text End Sub

'Check if can read/write to find PP If(checkaccessrights("HKEY_CURRENT_USER\Software\Microsoft\") <> true) Then Writeln "Error 1: Insufficient permissions to check for PowerPoint." quit End If

'Check which PP version If keyExists(PowerPoint2010) Then PPset PowerPoint2010, "PowerPoint 2010 found..." ElseIf keyExists(PowerPoint2007) Then PPset PowerPoint2007, "PowerPoint 2007 found..." ElseIf keyExists(PowerPoint2003) Then PPset PowerPoint2003, "PowerPoint 2003 found..." Else Writeln "Error 2: PowerPoint 2003, 2007, and 2010 not found." End