PPT.ResampleMedia in MS PowerPoint 2010 to Resample and Reset Resolution of a Video in VB.NET

In this article I am going to explain about how to resample and reset resolution of a video in a Microsoft PowerPoint 2010 presentation.
  • 2056

Introduction

In this article I am going to explain about how to resample and reset resolution of a video in a Microsoft PowerPoint 2010 presentation. For this we use  PPT.ResampleMedia in Microsoft PowerPoint 2010. Using PPT.ResampleMedia you can resample and reset resolution of a video in a Microsoft PowerPoint 2010 presentation.

In this application you have to insert a video in your presentation. For this click on insert tab and then click on Video then Video from file. Now select video file then click on insert.

Microsoft Office 2010 offer some powerful tools, using this tools you can create application. Using Microsoft Visual Basic for Applications (VBA) you can create your own application according to your need. These application can performer some specific task.

For creating application we can use

  • VBA host of Excel 2010
  • VBA host of PowerPoint 2010
  • VBA host of Word 2010

NOTE : OneNote 2010 is not a VBA host.

Code that we use in this application are given below

Sub ResampleDemo() 

    Dim vip As Shape
    For Each vip In ActivePresentation.Slides(1).Shapes  

        If vip.Type = msoMedia 
Then
            Debug.Print("Media Element: " & vip.Name)
 
            Dim newWidth As 
Integer
            Dim newHeight As 
Integer
            newHeight = 240
            newWidth = 320
          
            vip.MediaFormat.Resample(True, newHeight, newWidth)
            
Do
                DoEvents()
                Pause(1)
                Debug.Print("Resample status: " & vip.MediaFormat.ResamplingStatus)
            Loop While vip.MediaFormat.ResamplingStatus = ppMediaTaskStatusInProgress
            Debug.Print("Resample status: " & vip.MediaFormat.ResamplingStatus)
            If vip.MediaFormat.ResamplingStatus = ppMediaTaskStatusDone 
Then
                vip.Width = newWidth
                vip.Height = newHeight

            End 
If
        End 
If
    Next vip

End
 Sub
 

Function
 Pause(numberOfSeconds As Object)

    Dim startTime, endTime As 
Object 
    startTime = Timer
    endTime = startTime + numberOfSeconds
 
    Do While Timer < endTime
        DoEvents()
    
Loop


End
 Function

Steps for creating Application

Step 1 : Start Microsoft PowerPoint 2010 : 
 

1.jpg
 

Step 2 : Now you have to insert a video in your presentation. For this click on insert tab and then click on video ==> Video from file :

Clipboard07.jpg
 

Step 3 : Now select video file then click on insert :

Clipboard08.jpg
 

Step 4 : Now you have video in presentation :

Clipboard01.jpg
 

Step 5 : Using Alt + F11 Key Start Visual Basic for Applications (VBA) Window :

2.jpg

Step 6 : Select on VBAProject(Presentation 1) : 
 

3.jpg
 

Step 7 : Right Click On VBAProject(Presentation 1) ==> Goto Insert==> Goto Module & click on Module:

4.jpg

5.jpg
 

Step 8 : Write Code in Visual Basic for Applications (VBA) Window :

Clipboard06.jpg
 

Step 9 : Run Application using F5 :

Step 10 : Macros window will open, Select Macros name and click on Run Button :

Clipboard04.jpg
 

Step 11 : Output of Application : 
This application decrease the resolution of video 
 

Clipboard02.jpg

Categories

More Articles

© 2020 DotNetHeaven. All rights reserved.