Req. Help to "Play MIDI for 20sec in LOOP"

  • Thread starter Thread starter mehulrajani
  • Start date Start date
M

mehulrajani

Hello Friends
I want to play midi file in power point for 20 seconds in loop i.e. i
the file is smaller than 20 seconds then it will be repeated fro
beginning if it is longer than it will get played only for 20 seconds
Can anyone help me by providing VBA code for it or can anyone guid
me.

Thanks

Mehu
 
I got a code after searching google and modified as per my needs
The modified code is as follows:
================================================
Option Explicit



Private StartTime As Double
Private Const PlayForSeconds As Double = 20 'No. of seconds yo
want to play sound
Private Const BaseMusicDirectory As String = "Music" 'The Bas
Directory in which you have music file


Private Declare Function GetShortPathName Lib "kernel32" Alia
"GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPat
As String, ByVal cchBuffer As Long) As Long
Private Declare Function mciGetErrorString Lib "winmm.dll" Alia
"mciGetErrorStringA" (ByVal dwError As Long, ByVal lpstrBuffer A
String, ByVal uLength As Long) As Long
Private Declare Function mciSendString Lib "winmm.dll" Alia
"mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnStrin
As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) A
Long

Public Function SendMeFile2Play(OnlyFileName As String)
PlayMIDI PowerPoint.Application.ActivePresentation.Path & "\"
BaseMusicDirectory & "\" & OnlyFileName, True
End Function





Public Function PlayMIDI(DriveDirFile As String, Optional loopIT A
Boolean)
Dim returnStr As String * 255
Dim Shortpath$, X&
Shortpath = Space(Len(DriveDirFile))
X = GetShortPathName(DriveDirFile, Shortpath, Len(Shortpath))
If X = 0 Then GoTo errorhandler
If X > Len(DriveDirFile) Then 'not a long filename
Shortpath = DriveDirFile
Else 'it is a long filename
Shortpath = Left(Shortpath, X) 'x is the length of the retur
buffer
End If
X = mciSendString("close yada", returnStr, 255, 0) 'just in case
X = mciSendString("open " & Chr(34) & Shortpath & Chr(34) & " typ
sequencer alias yada", returnStr, 255, 0)

If X <> 0 Then GoTo theEnd 'invalid filename or path

X = mciSendString("play yada", returnStr, 255, 0)

If X <> 0 Then GoTo theEnd 'device busy or not ready

If Not loopIT Then Exit Function

StartTime = Timer

Do While True
X = mciSendString("status yada mode", returnStr, 255, 0)
If X <> 0 Then
Exit Function 'StopMIDI() was pressed or error
End If

If (StartTime + PlayForSeconds) > Timer Then
If Left(returnStr, 7) = "stopped" Then
X = mciSendString("play yada from 0", returnStr, 0, 0)
End If
Else
StopMIDI2
' Slide2.TextBox1.Visible = False
Exit Function

End If

' If Slide2.TextBox1.Visible = False Then Slide2.TextBox1.Visible
True

Slide2.TextBox1.Text = CStr(CInt((StartTime + PlayForSeconds)
Timer))

DoEvents
Loop


theEnd: 'MIDI errorhandler
Slide2.TextBox1.Visible = False
returnStr = Space(255)
X = mciGetErrorString(X, returnStr, 255)
MsgBox Trim(returnStr), vbExclamation 'error message
X = mciSendString("close yada", returnStr, 255, 0)
Exit Function

errorhandler:
MsgBox "Invalid Filename or Error.", vbInformation
End Function



Public Function StopMIDI2()
Dim X&
Dim returnStr As String * 255

X = mciSendString("stop yada", 0&, 0, 0)

End Functio
 
I got a code after searching google and modified as per my needs
The modified code is as follows:
Click to expand...

Hi ... thanks for taking the time to post the code here.
 
[CRITICAL UPDATE - Anyone using Office 2003 should install the critical
update as soon as possible. From PowerPoint, choose "Help -> Check for
Updates".]

Hello,

As you have discovered, PowerPoint doesn't provide the functionality that
you are looking for without resorting to VBA or add-ins.

If you (or anyone else reading this message) think that it's important that
PowerPoint provide this kind of functionality (without having to resort to
VBA or add-ins), don't forget to send your feedback (in YOUR OWN WORDS,
please) to Microsoft at:

http://register.microsoft.com/mswish/suggestion.asp

As with all product suggestions, it's important that you not just state
your wish but also WHY it is important to you that your product suggestion
be implemented by Microsoft. Microsoft receives thousands of product
suggestions every day and we read each one but, in any given product
development cycle, there are only sufficient resources to address the ones
that are most important to our customers so take the extra time to state
your case as clearly and completely as possible.

IMPORTANT: Each submission should be a single suggestion (not a list of
suggestions).

John Langhans
Microsoft Corporation
Supportability Program Manager
Microsoft Office PowerPoint for Windows
Microsoft Office Picture Manager for Windows

For FAQ's, highlights and top issues, visit the Microsoft PowerPoint
support center at: http://support.microsoft.com/default.aspx?pr=ppt
Search the Microsoft Knowledge Base at:
http://support.microsoft.com/default.aspx?pr=kbhowto

This posting is provided "AS IS" with no warranties, and confers no rights.
Use of any included script samples are subject to the terms specified at
http://www.microsoft.com/info/cpyright.htm
 
Back
Top