OfficeTips Home || VBA Section || General Section || Download Section || Privacy Policy

Clear the Clipboard in Office 2000
Share |

Office 2000 has a neat new feature, multiple clipboards. In fact you can save upto 12 different objects in the clipbook. However unfortunately there is no direct method available to clear all it's contents. The code snippet below is one workaround to this problem. 

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub ClearTheClipBoard()
Dim oClipClear As CommandBarButton
On Error Resume Next
Set oClipClear = Application.CommandBars("clipboard") _
                .FindControl(Id:=3634)
If Not oClipClear Is Nothing Then
    If oClipClear.Enabled Then oClipClear.Execute
End If
On Error GoTo 0
End Sub

 

Determine which shape was clicked (PowerPoint only)

Initially I was under the impression that this was an undocumented aspect. However I did manage to locate an obscure reference to this feature in the help files. It is possible to assign the same macro to multiple shapes (Action Setting | Macro) and ascertain which shape was the one that invoked the macro by declaring the macro in the manner shown below. This also work if the action settings are set to work on mouse over.

  • Insert a code module into the VBA project and paste the code given below.

  • Revert back to the PowerPoint Window and draw two shapes on the slide.

  • Assign action settings (click or mouse over) to both shapes - set to run the macro 'Identify'

  • Run the show, click on each of the shapes to view the result.

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub Identify( oShp as Shape)
Msgbox oShp.Name, vbInformation+vbOkOnly
End Sub

 

Two methods to play sound files (*.WAV) files synchronously/asynchronously

Couple of faster methods to play sounds file in VBA using API calls.

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Option Explicit
' ===== API declarations =====
Private Declare Function sndPlaySound Lib "winmm.dll" _
            Alias "sndPlaySoundA" _
                (ByVal lpszSoundName As String, _
                 ByVal uFlags As Long) As Long

Private Declare Function PlaySound Lib "winmm.dll" _
            Alias "PlaySoundA" _
                (ByVal lpszName As String, _
                 ByVal hModule As Long, _
                 ByVal dwFlags As Long) As Long

' Sound Flag
Private Const SOUND_FILENAME = &H20000

' ===== Method 1 =====
Public Function PlaySoundFileA(sndFileName As String) As Boolean
Dim iSuccess As Integer
iSuccess = sndPlaySound(sndFileName, SOUND_FILENAME)  
If iSuccess = 0 Then
    PlaySoundFileA = False
Else
    PlaySoundFileA = True
End If
End Function
' ===== Method 2 =====
Public Function PlaySoundFileB(ByVal sndFileName As String) As Boolean
Dim iSuccess As Integer
iSuccess = PlaySound(sndFileName, 0&, SOUND_FILENAME)
If iSuccess = 0 Then
    PlaySoundFileB = False
Else
    PlaySoundFileB = True
End If
End Function
'===== Test the functions ======
Sub TestSounds()
Debug.Print PlaySoundFileB("D:\temp\mysound.wav")
Debug.Print PlaySoundFileA("D:\temp\mysound.wav")
End Sub

 

How to update information within unrelated excel objects inserted in slides of a presentation

We can set a hook in to the Deactivate event of Excel. This is a single event handler for all excel events. So it doesn't really matter which excel object has been edited this routine will be able to update automatically.

I've used only one cell as an example to update across, the but same can be extended to handle to other cells too. The update routine can be performed by simply calling UpdateXLCells, however if you want to automate the process, set up the excel event handler first and then every time you change the value in B2 of any of the embedded XL (2nd slide to 4th) objects the value on the 1st slide will get updated.

The value will get updated even while you run the slide show... ie. if the action setting of the second xl object has been set to edit. Run the show, click on object. Change value, Update and return to PowerPoint, move to 1st slide and you will find that the value has been updated.

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

 
' ====== Class Module - EventClass =====
Option Explicit
Public WithEvents App As Excel.Application

Private Sub App_WorkbookDeactivate(ByVal Wb As Excel.Workbook)
Call UpdateXLCells
End Sub

' ====== End Of Class Module - EventClass =====

' ======= Module =======
Option Explicit
' ------ Code Specific to Hooking into Excel Events -----
Dim AppClass As New EventClass
Sub SetExcelHook()
Set AppClass.App = Excel.Application
End Sub

Sub UnHook()
AppClass.App = Nothing
End Sub

' ------ End Of Code Specific to Hooking into Excel Events -----

Sub UpdateXLCells()
Dim X As Integer
Dim Y As Variant
For X = 2 To 4
    Y = Y + GetXlRngValues(ActivePresentation.Slides(X).Shapes(1), "B2")
Next
SetXlRngValues ActivePresentation.Slides(1).Shapes(1), "B2", Y
End Sub

Function GetXlRngValues(oShape As PowerPoint.Shape, _
                                        Rng As String) As Variant
Dim XLObj As Excel.Workbook
Dim CellValues As Variant
Set XLObj = oShape.OLEFormat.Object
GetXlRngValues = XLObj.Worksheets(1).Range(Rng)

End Function

Sub SetXlRngValues(oShape As PowerPoint.Shape, _
                                Rng As String, Value As Variant)
Dim XLObj As Excel.Workbook
Dim CellValues As Variant
Set XLObj = oShape.OLEFormat.Object
XLObj.Worksheets(1).Range(Rng) = Value
End Sub
' ===== End Of Code =====

 

 Pause a show programmatically (even in Kiosk mode)

Three different approaches to the same. One which hides the buttons alternately and the other which merely manipulates the Z-order. The latter requires the buttons to be overlapping to function as required. And finally one which merely changes the caption and determines the state of the show based on it.

Note: Example 3 uses only one shape.

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

' - - - - - Example Set 1 - Hiding the shapes - - - - - -
' The drawback of this method is that if the Pause button is not visible
' when you exit the show, you would have to run code
' to make it visible again.

Sub PauseShow()
With SlideShowWindows(1)
    .View.State = ppSlideShowPaused
    .Presentation.SlideMaster.Shapes("Pause").Visible = False
    .Presentation.SlideMaster.Shapes("Resume").Visible = True
End With
End Sub

Sub ResumeShow()
With SlideShowWindows(1)
    .View.State = ppSlideShowRunning
    .Presentation.SlideMaster.Shapes("Pause").Visible = True
    .Presentation.SlideMaster.Shapes("Resume").Visible = False
End With
End Sub
' - - - - - End Of Set 1

' - - - - - Example Set 2 - Manipulating the Z-order
' I prefer this approach when using two button approach
' because I don't neccessarily need code to bring the Pause
' button to Top while running the show, it can be done thru
' the Draw Menu. Since the shape are overlaying each
' other sending one behind the other brings the other to the top.

Sub PauseShow()
With SlideShowWindows(1)
    .View.State = ppSlideShowPaused
    .Presentation.SlideMaster.Shapes("Pause").ZOrder msoSendToBack
End With
End Sub

Sub ResumeShow()
With SlideShowWindows(1)
    .View.State = ppSlideShowRunning
    .Presentation.SlideMaster.Shapes("Resume").ZOrder msoSendToBack
End With
End Sub
' - - - - - End Of Set 2 - - - - -

' - - - - - Beginning  Of Set 3 - - - - -
Sub PauseResumeToggle()
With SlideShowWindows(1)
If .View.State = ppSlideShowPaused Then
    .Presentation.SlideMaster.Shapes("PauseButton").TextFrame _
                .TextRange.Text = "Pause"
    .View.State = ppSlideShowRunning
Else
    .Presentation.SlideMaster.Shapes("PauseButton").TextFrame _
                .TextRange.Text = "Resume"
    .View.State = ppSlideShowPaused
End If
End With
End Sub
' - - - - - End Of Set 3 - - - - -

 

Print the current slide in a show

How to print the current slide during a show is a question that crops up on the NG and the recorder is of little use. To run this example:

  • Switch to the Slide Master View.

  • Draw a shape on the master slide

  • Select Action Settings for the Shape and assign it to run the macro given below.

  • Switch back to the Slide View, run the show.

  • Click on the shape, and it will print the current slide in the running presentation show.

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub PrintCurrentSlide()
' Get current slide number in the running show.
Dim SldNo As Long
Dim Pres As Presentation
SldNo = SlideShowWindows(1).View.Slide.SlideIndex
Set Pres = SlideShowWindows(1).Presentation
With Pres.PrintOptions
         ' Set the shaperange type to slides
         .RangeType = ppPrintSlideRange
         .NumberOfCopies = 1
         .Collate = msoTrue
         .OutputType = ppPrintOutputSlides
         .PrintHiddenSlides = msoTrue
         .PrintColorType = ppPrintBlackAndWhite
         .FitToPage = msoFalse
         .FrameSlides = msoFalse
         ' Clear existing ranges
         .Ranges.ClearAll
        ' Set the print range to current slide
        .Ranges.Add SldNo, SldNo
End With
Pres.PrintOut
Set Pres = Nothing
End Sub

 

Extract embedded sound files (*.WAV)

Make use of hidden and undocumented SoundFormat object to export sound files. To learn more about the SoundFormat object, Press F2 while in the VBE, set the object browser to display hidden members and search for SoundFormat object.

' --------------------------------------------------------------------------------
' Copyright ©1999-2018, Shyam Pillai, All Rights Reserved.
' --------------------------------------------------------------------------------
' You are free to use this code within your own applications, add-ins,
' documents etc but you are expressly forbidden from selling or
' otherwise distributing this source code without prior consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in text or html format.
' --------------------------------------------------------------------------------

Sub ExtractWavFile()
Dim oShp As Shape
Set oShp = ActiveWindow.Selection.ShapeRange.Item(1)

With oShp
    If .Type = msoMedia Then
        If .MediaType = ppMediaTypeSound Then
            If Dir(.SoundFormat.SourceFullName) <> "" Then
                If MsgBox("Overwrite the original file?", _
                    vbQuestion + vbYesNo, "File already exists") = vbYes Then
                    .SoundFormat.Export .SoundFormat.SourceFullName
                End If
            End If
        End If
    End If
End With
End Sub

 
 

Copyright 1999-2018 (c) Shyam Pillai. All rights reserved.