Tạo âm thanh (1 người xem)

[LearnExcel]

Ứng dụng sau sẽ tạo ra âm thanh (để cảnh báo chẳng hạn) ngay cả khi PC (ở cơ quan) không có loa.

Option Explicit 
Private Declare Function BeepA Lib "kernel32" Alias "Beep" ( _ 
ByVal Frequency As Long, ByVal Duration As Long) As Long 
 
Public Sub CustomBeep() 
    Dim intFrq As Integer 
    Const lngStep_c As Long = 150 
    Const lngMillisecond_c As Long = 1 
    Const lngUprBnd_c As Long = 6000 
    Const lngLwrBnd_c As Long = 100 
    For intFrq = lngLwrBnd_c To lngUprBnd_c Step lngStep_c 
        PCSpeakerSound intFrq, lngMillisecond_c 
    Next 
    For intFrq = (lngUprBnd_c - lngStep_c) To (lngLwrBnd_c + lngStep_c) Step -lngStep_c 
        PCSpeakerSound intFrq, lngMillisecond_c 
    Next 
End Sub 
 
Public Sub PCSpeakerBeep() 
     'Note: This function is asynchronous.
    On Error Resume Next 
    Const strCommand_c As String = "cmd /c echo " 
    Const lngBellChr_c As Long = 7 
    VBA.Shell strCommand_c & VBA.Chr$(lngBellChr_c), vbHide 
End Sub 
 
Public Sub PCSpeakerSound(Frequency As Integer, Duration As Long) 
     'Purpose:   Sends as sound to the PC speaker
     'Input  :   -Frequency: Specifies the frequency (in hertz)
     '            of the sound to be sent to the speaker. Only
     '            accepts values from 37 through 32,767.
     '           -Duration:  Length of the sound in milliseconds.
    Const lngValidLwrBnd_c As Long = 37 
    Const lngValidUprBnd_c As Long = 32767 
    Const strError_c As String = "Invalid value for parameter" & _ 
    """Frequency"". Values must " & _ 
    "be 37 through 32,767." 
    If Frequency < lngValidLwrBnd_c Then 
        VBA.Err.Raise vbObjectError, VBA.Err.Source, strError_c 
    ElseIf Frequency > lngValidUprBnd_c Then 
        VBA.Err.Raise vbObjectError, VBA.Err.Source, strError_c 
    Else 
        If BeepA(Frequency, Duration) = False Then 
            VBA.Err.Raise vbObjectError, "PCSpeakerSound", "Speaker not found." 
        End If 
    End If 
End Sub

Nguồn http://www.vbaexpress.com/kb/getarticle.php?kb_id=965

 

[nhthang]

toi chua hieu ban co the huong dan ky hon ko

 

[boong]

Public Sub PCSpeakerSound(Frequency As Integer, Duration As Long)      'Purpose:   Sends as sound to the PC speaker      'Input  :   -Frequency: Specifies the frequency (in hertz)      '            of the sound to be sent to the speaker. Only      '            accepts values from 37 through 32,767.      '           -Duration:  Length of the sound in milliseconds.     Const lngValidLwrBnd_c As Long = 37     Const lngValidUprBnd_c As Long = 32767     Const strError_c As String = "Invalid value for parameter" & _     """Frequency"". Values must " & _     "be 37 through 32,767."     If Frequency < lngValidLwrBnd_c Then         VBA.Err.Raise vbObjectError, VBA.Err.Source, strError_c     ElseIf Frequency > lngValidUprBnd_c Then         VBA.Err.Raise vbObjectError, VBA.Err.Source, strError_c     Else         If BeepA(Frequency, Duration) = False Then             VBA.Err.Raise vbObjectError, "PCSpeakerSound", "Speaker not found."         End If     End If End Sub

Bác ơi, sao thằng này không chạy gì hết vậy. Bác xem lại xem sao? Bác còn có các nào để tạo âm thanh khác nữa không. Và có thể cho chúng chạy theo trình tự số được không?