Cách phát âm thanh mp3 khi ấn Command Button trên userform

[mylanlinh]

Kính nhờ quý anh/chị/ em giúp đỡ Cách phát âm thanh khi ấn Command Button trên userform
Ví dụ: Khi ấn vào Command Button nào thì nó sẽ phát ra âm thanh đó.
(File đính kèm đây ạ)
Xin chân thành cảm ơn!

 

[Bluestar092011]

Kính nhờ quý anh/chị/ em giúp đỡ Cách phát âm thanh khi ấn Command Button trên userform
Ví dụ: Khi ấn vào Command Button nào thì nó sẽ phát ra âm thanh đó.
(File đính kèm đây ạ)
Xin chân thành cảm ơn!

Thêm code sau vào Module.

Option Explicit

Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
   lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
   hwndCallback As Long) As Long

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
    (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long

Private sMusicFile As String
Dim Play

Public Sub PlaySound(ByVal File$)

sMusicFile = GetShortPath(File)

Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
If Play <> 0 Then 'this triggers if can't play the file
   'Play = mciSendString("'play " & sMusicFile & "'", 0&, 0, 0) 'i tried this aproach, but doesn't seem to work
End If

End Sub

Public Sub StopSound(Optional ByVal FullFile$)
Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

Public Function GetShortPath(ByVal strFileName As String) As String
    Dim lngRes As Long, strPath As String
    strPath = String$(165, 0)
    lngRes = GetShortPathName(strFileName, strPath, 164)
    GetShortPath = Left$(strPath, lngRes)
End Function

Sau đó dùng lệnh sau để đọc file MP3.

Call PlaySound(ThisWorkbook.Path & "\MP3\Hello.mp3")

 

[mylanlinh]

Thêm code sau vào Module.

Option Explicit

Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias _
   "mciSendStringA" (ByVal lpstrCommand As String, ByVal _
   lpstrReturnString As Any, ByVal uReturnLength As Long, ByVal _
   hwndCallback As Long) As Long

Private Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" _
    (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal lBuffer As Long) As Long

Private sMusicFile As String
Dim Play

Public Sub PlaySound(ByVal File$)

sMusicFile = GetShortPath(File)

Play = mciSendString("play " & sMusicFile, 0&, 0, 0)
If Play <> 0 Then 'this triggers if can't play the file
   'Play = mciSendString("'play " & sMusicFile & "'", 0&, 0, 0) 'i tried this aproach, but doesn't seem to work
End If

End Sub

Public Sub StopSound(Optional ByVal FullFile$)
Play = mciSendString("close " & sMusicFile, 0&, 0, 0)
End Sub

Public Function GetShortPath(ByVal strFileName As String) As String
    Dim lngRes As Long, strPath As String
    strPath = String$(165, 0)
    lngRes = GetShortPathName(strFileName, strPath, 164)
    GetShortPath = Left$(strPath, lngRes)
End Function

Sau đó dùng lệnh sau để đọc file MP3.

Call PlaySound(ThisWorkbook.Path & "\MP3\Hello.mp3")

Mình thêm vào userform và báo lỗi. Có thể chỉnh dùm mình trên user form đính kèm được ko ạ?

 

[Bluestar092011]

Mình thêm vào userform và báo lỗi. Có thể chỉnh dùm mình trên user form đính kèm được ko ạ?

Xem file

 

[mylanlinh]

Xem file

Khi chọn mục 1 thì phát ra âm thanh của mục 1 (có 3 file), chọn mục 2 thì phát ra âm thanh của mục 2 (cũng có 3 file # âm thanh mục 1) thì sao ạ?

 

[Bluestar092011]

Khi chọn mục 1 thì phát ra âm thanh của mục 1 (có 3 file), chọn mục 2 thì phát ra âm thanh của mục 2 (cũng có 3 file # âm thanh mục 1) thì sao ạ?

Nhưng trong thư mục MP3 có cái tệp nào liên quan đến mục 1, mục 2 đâu mà phát.

 

[mylanlinh]

Nhưng trong thư mục MP3 có cái tệp nào liên quan đến mục 1, mục 2 đâu mà phát.

Mình mới thêm mấy file âm thanh để phát cho 4 mục đầu đây ạ, mỗi mục có 3 command button (chọn vào mỗi STT 1, 2, 3, ....thì: command button 1- phát 1a.mp3, command button 2- phát 1b.mp3, command button 3 - phát 1c.mp3, ......)

 

[anhdepjai]

Mình nghĩ bạn đang làm 1 bản hướng dẫn học tiếng Anh.
Bạn thử cái này xem có OK ko
Sub Test()
Dim objSpvoice As Object
Set objSpvoice = CreateObject("sapi.spvoice")
objSpvoice.Speak "Test", 1
End Sub

 

[HeSanbi]

Nếu đọc tiếng Anh bằng giọng đọc Window thì hàm đầy đủ như sau:

Hàm đọc và đợi đọc xong:
Call SpeakerXL_Busy(<Chuỗi để đọc>, <Tốc độ đọc 0.5 đến 4.0>, <Âm lượng 1 đến 100>, <Giọng đọc 0 -> ... >)

Hàm đọc nhưng không đợi:
Call SpeakerXL(<Chuỗi để đọc>, <Tốc độ đọc 0.5 đến 4.0>, <Âm lượng 1 đến 100>, <Giọng đọc 0 -> ... >)

Tiếng Anh có nhiều giọng đọc và phải tải về các giọng đọc nam nữ Anh, Mỹ, Úc, ... không thì đọc với giọng mặc định
----------------------------

' Speaker
Option Explicit
#If VBA7 Then
  Private Declare PtrSafe Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
  Private Declare PtrSafe Function GetShortPathName Lib "KERNEL32" Alias "GetShortPathNameW" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
#Else
  Private Declare  Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long
  Private Declare  Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameW" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
#End If

Private Sub SpeakerXL_Busy_Test()
  Call SpeakerXL_Busy("My NickName is Sanbi", 1.5)
End Sub

Sub SpeakerXL_Busy(Optional Text As String, _
              Optional Speed As Double = 1, _
              Optional Volume As Integer = 100, _
              Optional Speaker As Integer = 0)
  DoEvents
  Dim oVoice As Object
  Set oVoice = VBA.CreateObject("SAPI.SpVoice")
  Set oVoice.Voice = oVoice.GetVoices.Item(Speaker)
  oVoice.Rate = Speed
  oVoice.Volume = Volume
  oVoice.Speak Text
  Set oVoice = Nothing
End Sub

Private Sub SpeakerXL_test()
  Call SpeakerXL("My NickName is Sanbi", 1.5, 100, 0, 0)
End Sub
Sub SpeakerXL(Optional Text As String, _
              Optional Speed As Double = 1, _
              Optional Volume As Integer = 100, _
              Optional Speaker As Integer = 0)
  On Error Resume Next
  Call mciSendString("close all", "", 0, 0)
  Const SAFT48kHz16BitStereo = 39
  Const SSFMCreateForWrite = 3
  Dim oFileStream As Object
  Dim oVoice As Object
  Dim xpath As String
  xpath = VBA.Environ$("temp") & "\Sample.wav"
  GoSub Save
  xpath = GetShortPath(xpath)
  Set oFileStream = VBA.CreateObject("SAPI.SpFileStream")
  oFileStream.Format.Type = SAFT48kHz16BitStereo
  oFileStream.Open xpath, SSFMCreateForWrite, True
  Set oVoice = VBA.CreateObject("SAPI.SpVoice")
  Set oVoice.Voice = oVoice.GetVoices.Item(Speaker)
  Set oVoice.AudioOutputStream = oFileStream
  oVoice.Volume = Volume 
  oVoice.Rate = Speed
  oVoice.Speak Text, SpeechLib.SpeechVoiceSpeakFlags.SVSFDefault
  oFileStream.Close
  Set oFileStream = Nothing
  Set oVoice = Nothing
  Call mciSendString("open " & xpath & " alias fmusic", "", 0, 0)
  Call mciSendString("play fmusic", "", 0, 0)
Exit Sub
Save:
  With VBA.CreateObject("ADODB.Stream")
    .Type = 2 'Stream type
    .Charset = "utf-8" 'or utf-16 etc
    .Open
    .WriteText ""
    .SaveToFile xpath, 2 'Save binary data To disk
  End With
  VBA.err.Clear
Return
End Sub

Private Function GetShortPath(ByVal Path As String) As String
  Dim ret&, Buff As String * 512
  ret = GetShortPathName(VBA.StrConv(Path, 64), Buff, 512)
  GetShortPath = VBA.Left(StrConv(Buff, 128), ret)
End Function

 

[anhdepjai]

Hàm đọc nhưng không đợi: Mình test không hoạt động được bạn ah,
Mình đang dùng cái đọc như bài #8 nhưng thấy không ổn chút nào vì cứ phải đợi nó đọc xong thì mới chạy lệnh lưu file được