สอบถามการใส่เสียง Beep ตอนขึ้น Massess Box ครับ

[ชวลิต เสนะสุทธิ]

สอบถามการใส่เสียง Beep ตอนขึ้น Massess Box ครับ
ให้เสียงดังจนกว่าจะกดปิด Massess Box ครับ

Private Sub QRCode_AfterUpdate()
 Dim wisroot As String
  Dim str1 As String
  wisroot = Me.[QRCode].Value
  str1 = "[QRCodePCB]=" & "'" & wisroot & "'"
 
  If Me.[QRCode] = DLookup("[QRCodePCB]", "dbo_AOI40241CA", str1) Then
  MsgBox "ข้อมูลซ้ำกัน กรุณาตรวจสอบ"
  Me.Undo
  Else


ขอบคุณครับ

[PNR]

Private Sub QRCode_AfterUpdate()
 Dim wisroot As String
  Dim str1 As String
  wisroot = Me.[QRCode].Value
  str1 = "[QRCodePCB]=" & "'" & wisroot & "'"
 
  If Me.[QRCode] = DLookup("[QRCodePCB]", "dbo_AOI40241CA", str1) Then
  beep
  MsgBox "ข้อมูลซ้ำกัน กรุณาตรวจสอบ"
  Me.Undo
  Else

[ชวลิต เสนะสุทธิ]

ประมาณเสียงเพลง หรือ เสียงไซเลนครับ
เสียง Beep ไม่มีเสียงเลย

[PNR]

ประมาณเสียงเพลง หรือ เสียงไซเลนครับ
เสียง Beep ไม่มีเสียงเลย

งั้นคำสั่งให้เล่นเสียง wav ได้ไหม

[ชวลิต เสนะสุทธิ]

ได้ครับ เพราะโจทย์ที่ได้มาคือ เมื่อมี  bopup Massess Box ขึ้นมาให้มีเสียงครับ เสียงอะไรก่ได้

[PNR]

1.ให้เพิ่มโค้ดที่โมดูล

โค๊ด: [Select]

Declare Function apisndPlaySound Lib "winmm" Alias "sndPlaySoundA" (ByVal filename As String, ByVal snd_async As Long) As Long
Function Playsound(sWavFile As String)
If apisndPlaySound(sWavFile, 1) = 0 Then
MsgBox "ไม่พบเสียง!"
End If
End Function

2. จากโค้ดเดิม เพิ่มเป็นแบบนี้

Dim wisroot As String
  Dim str1 As String
  wisroot = Me.[QRCode].Value
  str1 = "[QRCodePCB]=" & "'" & wisroot & "'"
 
  If Me.[QRCode] = DLookup("[QRCodePCB]", "dbo_AOI40241CA", str1) Then
  Playsound ("C:\SoundFloderName\WavFileName.wav")
  MsgBox "ข้อมูลซ้ำกัน กรุณาตรวจสอบ"
  Me.Undo

[ชวลิต เสนะสุทธิ]

ลองที่ให้มา ไม่ได้ครับ แต่คุ้นผมเคยทำไว้ที่ Excel ตอนนี้ทำได้แล้วครับโดยใช้แบบนี้ครับ
1*** วางไว้ใน Module
#If Win64 Then
    Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
        ByVal hModule As LongPtr, ByVal dwFlags As Long) As Boolean
#Else
    Private Declare Function PlaySound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
        ByVal hModule As Long, ByVal dwFlags As Long) As Boolean
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000
Function SoundMe() As String
'Updateby Extendoffice 20161223
    Call PlaySound("c:\windows\media\policesiren.WAV", _
      0, SND_ASYNC Or SND_FILENAME)
    SoundMe = ""
End Function

2**** วางที่โค้ดต้องการให้ดัง
 Dim wisroot As String
  Dim str1 As String
 
wisroot = Me.[QRCode].Value
  str1 = "[QRCodePCB]=" & "'" & wisroot & "'"
 
  If Me.[QRCode] = DLookup("[QRCodePCB]", "dbo_Laser40241CA", str1) Then
  SoundMe
  MsgBox "ข้อมูลซ้ำกัน กรุณาตรวจสอบ"
  Me.Undo
  Else
    End If

[ชวลิต เสนะสุทธิ]

สุดท้ายครับ เจอปัญหาการปิด MsgBox ครับ คือเสียงไม่ยอมปิดตามครับ ดังตลอดจนกว่าความยาวของเพลงจะหมดครับ

[PNR]

ที่ Module

Option Compare Database
#If Win64 Then
    Private Declare PtrSafe Function PlaySound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
        ByVal hModule As LongPtr, ByVal dwFlags As Long) As Boolean
#Else
    Private Declare Function PlaySound Lib "winmm.dll" _
        Alias "PlaySoundA" (ByVal lpszName As String, _
        ByVal hModule As Long, ByVal dwFlags As Long) As Boolean
#End If
Const SND_SYNC = &H0
Const SND_ASYNC = &H1
Const SND_FILENAME = &H20000

Function SoundMe() As String
    Call PlaySound("c:\windows\media\policesiren.WAV", 0, SND_ASYNC Or SND_FILENAME)
    SoundMe = ""
End Function

Public Sub StopSound()
    PlaySound vbNullString, 0, 0
End Sub


ที่ command button เพิ่ม
  SoundMe 'เมื่อเล่นเสียงแล้ว ต่อไปจะเด้ง msgbox ก็ดักเงื่อนไขการกด OK
  If MsgBox("ข้อมูลซ้ำกัน กรุณาตรวจสอบ", vbOKOnly, "program") = vbOK Then
    StopSound
  End If

[ชวลิต เสนะสุทธิ]

ได้แล้วครับ ขอบคุณมากครับ