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:

Specify if you want to loop forever, the delay between frames (1000 ms = 1 second), click use delay entered above for all frames, and do "one frame per layer".

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

<source lang="vb"> 'Author: Smallman12q (https://wiki.riteme.site/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