Board logo

標題: EXCEL 發出聲音 [打印本頁]

作者: enoch    時間: 2012-6-29 17:56     標題: EXCEL 發出聲音

有一個工作表需要不停輸入資料
能否利用IF 條件, 當輸入資料遇到錯誤時發出聲音
請指教
作者: av8d    時間: 2012-6-29 19:28

本帖最後由 av8d 於 2012-6-29 19:38 編輯

回復 1# enoch


    [attach]11533[/attach]

是這樣嗎?
或是
Dim S1$
If S1 <> "" Then
        With 工作表1.WindowsMediaPlayer1     '加入MediaPlayer播放音樂
            .URL = "D:\我的音樂名稱.mp3"  '請修改音樂檔案
            .Visible = False        '隱藏WindowsMediaPlayer元件
            .Controls.Play          '播放音樂
        End With
End If

備註: 記得先插入一個WindowsMediaPlayer1元件

D:\我的音樂名稱.mp3   看你音樂是放C:還是D:~以上範例是放在D:
作者: kimbal    時間: 2012-6-29 21:13

有一個工作表需要不停輸入資料
能否利用IF 條件, 當輸入資料遇到錯誤時發出聲音
請指教
enoch 發表於 2012-6-29 17:56


VBA 內建功能,但非常細聲
  1. if .... then
  2.     Call Beep
  3. end if
複製代碼

作者: oobird    時間: 2012-6-29 21:55

先要解決的是EXCEL如何能得知你輸入錯誤?
如打一篇文章,打錯字時發聲提醒?
作者: enoch    時間: 2012-6-30 09:39

多謝指教,
原來加上聲音是這麼簡單的方法簡單,
但請問除了 BEEP 外, 還有其它內建的聲音選擇嗎

另外在EXCEL 如何插入WindowsMediaPlayer元件呢
作者: oobird    時間: 2012-6-30 10:47

本帖最後由 oobird 於 2012-6-30 13:26 編輯

http://www.funp.net/955169
原帖的連結:http://qa.pcuser.com.tw/modules/ ... =41630&forum=24
作者: av8d    時間: 2012-7-2 13:12

本帖最後由 av8d 於 2012-7-3 08:25 編輯

回復 5# enoch


    [attach]11555[/attach]


另外提供你一個可以發出聲音的~
是利用函數去發出聲音的~也蠻實用的~

在 Excel 中, 按 Alt F11 進入 Visiual Basic 編輯器畫面,
點選 [插入]/[模組], 畫面會跳出程式碼視窗, 在裡面複製貼上如下程式:
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Function SndPlay(Pathname As String) As Long
SndPlay = sndPlaySound(Pathname, SND_ASYNC)
End Function

然後切換回到 Excel 工作表, 在某個儲存格(不是A1或C5)輸入如下公式:
=IF(A1 < C5,sndplay("C:\Windows\Media\Windows XP 電話鈴聲.wav"),0)

註: 需確定 "C:\Windows\Media\ "裡有 "Windows XP 電話鈴聲.wav" 這個檔案
於是在 A1 和 C5 裡分別輸入數字, 當 A1 小於 C5 的時候,
電腦就會播放電話鈴聲

轉載於 http://tw.group.knowledge.yahoo.com/smt-knowldge/listitem/view?iid=15
作者: GBKEE    時間: 2012-7-4 17:31

回復 5# enoch
1.自訂函數
2.儲存格寫下公式如:  =IF(A1>5,PlaySound(TRUE),PlaySound(FALSE))
  1. Option Explicit
  2. Function PlaySound(Msg As Boolean)
  3.     Dim Spath As String, Cmd As String
  4.     Spath = "C:\Windows\Media\" & IIf(Msg, "Windows XP 啟動.wav", "Windows XP 登出音效.wav")
  5.     '存放音效的路徑: "C:\Windows\Media\"
  6.     Cmd = "C:\Program Files\Windows Media Player\wmplayer.exe " & Chr(34) & Spath & Chr(34)
  7.     '播放音效的程式: "C:\Program Files\Windows Media Player\wmplayer.exe " <-這裡要空一格
  8.     Shell Cmd, 0
  9. End Function
複製代碼

作者: enoch    時間: 2012-7-5 15:35

不好意思, 我實在不明白錯在那裡,
可否再次指教嗎?
作者: GBKEE    時間: 2012-7-5 15:58

回復 9# enoch
你少了\
Function PlaySound(Msg As Boolean)
    Dim Spath As String, Cmd As String
    Spath = "C:\Windows\Media\" & IIf(Msg, "Windows 開香檳.wav", "Windows 通知.wav")
    '存放音效的路徑: "C:\Windows\Media\"
    Cmd = "C:\Program Files (x86)\Windows Media Player\wmplayer.exe " & Chr(34) & Spath & Chr(34)
    '播放音效的程式: "C:\Program Files\Windows Media Player\wmplayer.exe " <-這裡要空一格
    Shell Cmd, 0
End Function
作者: enoch    時間: 2012-7-5 16:53

修改了錯處, 但都是沒有聲音
不肯定是否電腦問題

但請問若想簡單一點, 內建除了BEEP 聲外
還會有其它聲音嗎?
或如果要連繼BEEP 兩聲, 應該如何呢?
作者: oobird    時間: 2012-7-5 23:08

方法太多了,簡單寫幾個常用的:
  1. Private Declare Function mciExecute Lib "winmm.dll" (ByVal lpstrcommand As String) As Long
  2. Private Const Mic = "C:\Windows\Media\tada.wav"
  3. Sub op()
  4. mciExecute ("play " & Mic)
  5. End Sub

  6. Sub yy()
  7. cmd = "sndrec32 /play /close ""C:\Windows\Media\tada.wav"""
  8. Shell cmd, 6
  9. End Sub
  10. Sub xx()
  11. Beep
  12. Application.Wait (Now + TimeValue("0:00:1"))
  13. Beep
  14. End Sub
  15. Sub ww()
  16. Set oSa = CreateObject("SAPI.SpVoice")
  17.         oSa.Speak "misinput"
  18. End Sub
複製代碼

作者: oobird    時間: 2012-7-6 09:07

回復 12# oobird

突然想到,BEEP還可以編曲
  1. Declare Function Beep Lib "kernel32.dll" (ByVal dwFreq As Long, ByVal dwDuration As Long) As Long

  2. Sub yy()
  3. f = Array(100, 523, 587, 659, 698, 784, 879, 987, 1030)
  4. d = Array(5, 3, 3, 0, 4, 2, 2, 0, 1, 2, 3, 4, 5, 5, 5, 0, 5, 3, 3, 0, 4, 2, 2, 0, 1, 3, 5, 5, 3, 0, 2, 2, 2, 2, 2, 3, 4, 0, 3, 3, 3, 3, 3, 4, 5, 0, 5, 3, 3, 0, 4, 2, 2, 0, 1, 3, 5, 5, 1)
  5. For i = 0 To UBound(d)
  6. Beep f(d(i)), 500
  7. Next
  8. End Sub
複製代碼

作者: enoch    時間: 2012-7-6 12:09

辛苦了各位的指教,
試過了Sub OP 但奇怪在電腦內找不到tada.wav,
改用其它C:\Windows\Media\內的WAV檔反而播唔到
而Sub YY  去到Shell cmd, 6 顯示找不到檔案

而這問題會同電腦有關嗎?
現時電腦是WIN7 64BIT,  若執行到後, 在其它WINXP 電腦又會否出現問題

最終希望可以播到在C:\Windows\Media\ 內建的wav檔
作者: enoch    時間: 2012-7-12 11:27

我終於發現錯在那裡, 原來在C:\Windows\Media\ 見到的中文檔案名稱. 原來是騙人
Windows 通知.wav 名稱, 原來真實檔案名稱叫 Windows Notify.wav
唔怪得播唔到,  
多謝各位耐心指教
作者: StanleyVic    時間: 2012-7-19 16:28

本帖最後由 StanleyVic 於 2012-7-19 16:29 編輯

這個例子的提問太好了. 學習了...
我沒想過會用在Excel 去介定 對/錯.
平常都只會其他.. or msbox 提示..
不錯不錯..謝謝..
作者: ddtggg    時間: 2012-12-25 10:34

解說得很詳細呢!
作者: 自我感覺良好    時間: 2012-12-25 12:00

[attach]13680[/attach]附件是word要怎樣改成excel?
作者: GBKEE    時間: 2012-12-25 13:05

回復 18# 自我感覺良好
  1. Option Explicit
  2. 'API Class to take care of playing the file
  3. Public Declare Function sndPlaySound32 Lib "winmm.dll" _
  4. Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
  5.                         ByVal uFlags As Long) As Long
  6. Sub VBASound()
  7.     'Call Api to play LoadIt.wav witch is in the same folder as
  8.     'the active document!->ActiveWorkbook
  9.     Call sndPlaySound32(ActiveWorkbook.Path & "\LoadIt.WAV", 0)
  10.    
  11. End Sub
複製代碼
[attach]13681[/attach]
作者: 自我感覺良好    時間: 2012-12-25 15:43

[attach]13683[/attach]
還是不能用﹗
幫我看一下那裡出錯了……回復 19# GBKEE
作者: GBKEE    時間: 2012-12-25 15:55

回復 20# 自我感覺良好
你是在Excel 應用程式的VBA

  Call sndPlaySound32(ActiveWorkbook.Path & "\LoadIt.WAV", 0)
作者: 自我感覺良好    時間: 2012-12-25 16:23

Call sndPlaySound32(ActiveWorkbook.Path & "\LoadIt.WAV", 0)
Call sndPlaySound32(ActiveDocument.Path & "\LoadIt.WAV", 0)

excel跟word是不一樣的。
太感謝了
作者: 自我感覺良好    時間: 2012-12-25 17:30

Option Explicit

'API Class to take care of playing the file
Public Declare Function sndPlaySound32 Lib "winmm.dll" _
Alias "sndPlaySoundA" (ByVal lpszSoundName As String, _
                        ByVal uFlags As Long) As Long

聲音檔是wav
若要用mp3
那要怎樣改?
作者: GBKEE    時間: 2012-12-26 07:07

回復 23# 自我感覺良好
就在這主題理
作者: 自我感覺良好    時間: 2012-12-26 07:38

回復 24# GBKEE
http://hi.baidu.com/_pt98/item/a65477da91588e36e1f46f17

找到這些想辦法要使用它
使用wav檔,檔案太大了。同樣的聲音mp3只要0.1就夠了


API播放WAV,AVI,MP3,MID(來自網絡)

1.avi

' In standard module:
Public Play As Boolean
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 Returnstring As String

Sub AVI_Play()
Const FileName As String = "c:\mybestfile.avi"
If Dir(FileName) = "" Then Exit Sub
If Play Then AVI_Stop
Returnstring = Space(127)
mciSendString "open " & Chr(34) & FileName & Chr(34) _
& " type avivideo alias video", Returnstring, 127, 0
mciSendString "set video time format ms", Returnstring, 127, 0
mciSendString "play video from 0", Returnstring, 127, 0
Play = True
End Sub

Sub AVI_Stop()
mciSendString "close video", Returnstring, 127, 0
Play = False
End Sub

'In ThisWorkbook module:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Play Then AVI_Stop
End Sub

2.mp3

Option Explicit
Public 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
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long

Private Function ConvShortFilename(ByVal strLongPath$) As String
    Dim strShortPath$
    If InStr(1, strLongPath, " ") Then
        strShortPath = String(LenB(strLongPath), Chr(0))
        GetShortPathName strLongPath, strShortPath, Len(strShortPath)
        ConvShortFilename = Left(strShortPath, InStr(1, strShortPath, Chr(0)) - 1)
    Else
        ConvShortFilename = strLongPath
    End If
End Function

Public Sub MMPlay(ByRef FileName As String)                           '
    FileName = ConvShortFilename(FileName)                            '
    mciSendString "close " & FileName, vbNullString, 0, 0
    mciSendString "open " & FileName, vbNullString, 0, 0
    mciSendString "play " & FileName, vbNullString, 0, 0
End Sub

Public Sub MMStop(ByRef FileName As String)
    FileName = ConvShortFilename(FileName)                            '
    mciSendString "stop " & FileName, vbNullString, 0, 0
    mciSendString "close " & FileName, vbNullString, 0, 0
End Sub

3.wav

Public Declare Function PlaySound Lib "winmm.dll" Alias "PlaySoundA" (ByVal lpszName As String, ByVal hModule As Long, ByVal dwflags As Long) As Long

Sub Warning()
  PlaySound ThisWorkbook.Path + "\Warning.wav", 0&, &H1
End Sub

4.mid
Public Declare Function mciExecute Lib "winmm.dll" Alias " mciExecute" (ByVal lpstrCommand As String) As Long

Private Sub play()
Dim ReturnValue As Long
ReturnSoundValue = mciExecute("play C:\WIN95\MEDIA\CANYON.MID")
End Sub
作者: zhiolg    時間: 2015-12-22 01:53

我有個疑問
我在vba裡面用這個
Private Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
Function SndPlay(Pathname As String) As Long
SndPlay = sndPlaySound(Pathname, SND_ASYNC)
End Function

但是打開會一直叫,等他叫完才可以開始使用,是我哪邊寫錯還是缺了什麼嗎?




歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)