No.7ベストアンサー
- 回答日時:
こんにちは。
おまたせしてすみません。今回は、私自身が、学ばせていただきました。
お書きになっていたコードを私なりに書き換えてみました。
ユーザー定義関数ですが、ちょっと工夫をしてみました。
何も入れない状態ですと、数値を吐き出し、名称を入れると、その名称を調べます。
'//
Sub CheckSoundDevice()
Dim DevName As String
DevName = "" '"SONY"
If GetSoundDevices(DevName) Then
Application.Speech.Speak "テスト テスト", True
Else
MsgBox DevName & " OFF"
End If
End Sub
Function GetSoundDevices(Optional ByVal soundDevice As String) As Variant
'空白値ですと、
Dim MesStr As String
Dim objLocator As Object
Dim objService As Object
Dim objClassSet As Object
Dim objClass As Object
Dim iflg As Variant
'ローカルコンピュータに接続する。
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
Set objService = objLocator.ConnectServer
Set objClassSet = objService.ExecQuery("Select * From Win32_SoundDevice")
If soundDevice = "" Then
iflg = objClassSet.Count '数値を出力
Else
For Each objClass In objClassSet
If InStr(1, objClass.Name, soundDevice, vbTextCompare) > 0 Then
iflg = True 'True/False を出力
End If
Next
End If
GetSoundDevices = iflg
Set objClassSet = Nothing
Set objClass = Nothing
Set objService = Nothing
Set objLocator = Nothing
End Function
WindFallerさん、おはようございます
4時ごろまでやっていたのですが寝てしまいました
1、==================
'DevNameがヌルでUSB接続のSNYが電源OFFなら
'Application.Speech.Speak "Deviceは、" & DevName, True
'でエラー停止になるのでSpeech.Speakさせない
ことにしました
以下がそのマクロです
Sub CheckSoundDevice()
Dim DevName As String
'DevName = ""
DevName = Range("H37") 'SONY or 空白 or 他の機器名
'DevNameがヌルで電源OFFなら
'Application.Speech.Speak "Deviceは、" & DevName, True で
'エラー停止になるのでSpeech.Speakさせない
If GetSoundDevices(DevName) Then
If DevName <> "" Then
Application.Speech.Speak "Deviceは、" & DevName, True
Else
MsgBox "デバイス不明でスピーチ中止。H37にSONY(半角大文字)を登録する"
End If
Else
MsgBox DevName & " を ON にする"
End If
End Sub
2、======================
iflgをセルに表示しました
If soundDevice = "" Then
iflg = objClassSet.Count '数値を出力
Range("G37") = iflg
Else
3、さらにNo.5で教えていただいたマクロで、Sub 試聴 を作ってみます
接続機器がMsgBoxで表示されるので大変貴重なマクロです
私には絶対作れないマクロを親切丁寧に面倒見ていただき大変感謝しています
WindFallerさん作成のマクロを実行するときは、結果が楽しみでいつもドキドキ
です
No.5
- 回答日時:
試しに、このマクロで、device の Dead or Alive の違いが出るでしょうか?
Sub GetSounddevice()
Dim MesStr As String
Dim objLocator As Object
Dim objService As Object
Dim objClassSet As Object
'ローカルコンピュータに接続する。
Set objLocator = CreateObject("WbemScripting.SWbemLocator")
Set objService = objLocator.ConnectServer
Set objClassSet = objService.ExecQuery("Select * From Win32_SoundDevice")
For Each objClass In objClassSet
MesStr = MesStr & "Name: " & objClass.Name & vbCrLf
Next
MsgBox MesStr
Set objClassSet = Nothing
Set objClass = Nothing
Set objService = Nothing
Set objLocator = Nothing
End Sub
WindFallerさん、こんばんは
いつも最後まで面倒見ていただきありがとうございます
教えていただいたマクロを早速実行してみると
「objClass の変数が定義されていない」というメッセージが出ましたので
Dim objClass As Object の一行を追加しました
そして再度実行してみました
見事にメッセージボックスが出ました
マクロでここまでできるとは感動ものです
メッセージは次の通りです
アンプの電源 ”入り” で実行すると
Name:SONY USB DAC Amplifire
Name:Realtec High Definition Audio
OKボタン
のメッセージが出ました
アンプの電源 ”切り” で実行すると
Name:Realtec High Definition Audio
OKボタン
のメッセージです
サウンド窓の再生タグの表示は次のようになっています
スピーカー
Realtec High Definition Audio
無効
上記のように、オンボードのRealtec High Definition Audioを無効にして
SONY USB DAC Amplifire を通して音がなるように設定しています
見事に、第一段階である、”アンプ電源の入り切り”を検知しています
ありがとうございました
私の知識ではこの先はお手上げです
これから、どういう処理をしたら良いでしょうか
No.4
- 回答日時:
すみませんでした。
こちらで再現性が取れないのと、最近、事情があって昼間の数時間しか、本当の集中的な時間が取れないのです。それで、今、二つの方法を考えている最中です、
ひとつは、Win32 API で、再生デバイスを取得する方法と、もうひとつは、WMI に方法はなかったか、情報を取れないかと考えています。ご自身でも、可能かもしれませんね。
ネット検索で、StackOverFlow 掲示板にもあるにはあるのですが、解決策が見えてきません。
必ず、もう一度、可能・不可能の結果はお知らせします。
WindFallerさん、こんばんは
昼の時間帯に教えていただきながら、報告が深夜になってしまい申し訳ありません
また、いつも、目的達成まで何度も教えていただいて恐縮しています
No.2
- 回答日時:
まず、#1のmike_(g)さんへ
>質問内容の何処が Excel と関係があるのでしょうか?
Application.Speech.Speak "test", True
このApplication は、一般的には、Excelのことです。
本題です。
この質問は、
>これはハードのエラーなので、エラー処理は無理でしょうか
つまり、音声装置(sound device)の dead or alive をAPI等を使って検査する方法かとは考えたのですが、Application.Speech ですと、その戻り値がありません。同様の質問は、ネット検索でも見つかるのですが、その解決手段が見当たりません。
そこで、ひとつの提案としては、Speech オブジェクトではなく、同じものを経由を変えてSAPI を使ってみたらどうかと考えています。あいにく、私のところでは、SAPIのStatus など調べてみたものの、出てきませんでした。それに、エラーがでませんので、エラートラップで挟むぐらいしかアイデアがありません。
Sub SpeakTest()
Dim objSpch As Object
Dim SAPIVoice As SpVoice '参照設定:Microsoft Speech Object Library
Set SAPIVoice = New SpVoice
Const jpSENTENSE As String = "わたしは月のうさぎ"
Const enSENTENSE As String = "I am Pretty Guardian Salor-Moon"
Const JP As String = "411"
Const EN As String = "409"
On Error Resume Next
SAPIVoice.Speak "<xml><lang langid=""" & JP & """>" & jpSENTENSE
SAPIVoice.Speak "<xml><lang langid=""" & EN & """>" & enSENTENSE
On Error GoTo 0
End Sub
WindFallerさん、親切に教えていただきありがとうございます
仕事の都合で報告がこの時間帯になってしまいました
密かに期待して早速実行してみました
日本語と英語でSpeakしてくれます
ただ残念ながら、”アンプ電源入れ忘れ”に対してエラー処理はしてくれません
下記のエラーメッセージが出ます
実行時エラー '-2147200966(8004503a)':
'Speak'メソッドは失敗しました'IspeechVoice'オブジェクト
素人の私は、「エラーメッセージが出る=エラーと認識している」と
思うのですが、どうやら”On Error Resume Next”の限界のようです
休日の貴重な時間に教えていただきましてありがとうございました
No.1
- 回答日時:
質問内容の何処が Excel と関係があるのでしょうか?
「アンプの電源を入れ忘れ」がどうして此処(Excel)と関係ありと思うのですか?
mike_gさん、こんにちは
gooの皆さんにお世話になって作ったマクロを8人で使っておりまして
前々から、「電源入れ忘れでマクロが止まるので対策を取れ」との苦情が有るのですが
私は、「ハードのエラーで無理」と逃げてきたのです
確かに「アンプの電源入れ忘れ」ですから、エクセルの範囲外なのですが
もしや、Application.Speech.Speak "test", True 自体にエラー処理の方法が
有ればと思い質問させていただきました
気分を害したようでお許しください
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) 【VBAエラー】Nextに対するForがありません 対策について 5 2022/11/21 21:26
- Visual Basic(VBA) 【VBA】ボタンに登録したマクロがエラーになる 4 2022/07/25 17:47
- Visual Basic(VBA) エクセルVBA 3 2022/06/23 20:00
- Visual Basic(VBA) セルS2に入力した「月」と一致したB列の右隣へセルS110の値を転記する下記マクロを実行するとエラー 2 2022/12/06 17:32
- Visual Basic(VBA) vbaエクセルマクロについて あるデータを作成し、デスクトップに.xlsx形式で保存するマクロを作成 2 2023/03/02 18:54
- Visual Basic(VBA) エクセルVBAで以下のようなコードを書いたらエラーになりました。何処が間違っているの教えて? 1 2023/02/10 18:30
- Visual Basic(VBA) Worksheets メソッドは失敗しました。のエラー処理のやり方 4 2022/05/29 21:29
- Visual Basic(VBA) DisplayAlertsブロパティで ”実行時エラー424オブジェクトが必要です” 5 2022/05/15 18:02
- Visual Basic(VBA) 【VBA】Excelの特定範囲のセルを画像で保存したい 2 2023/01/25 13:06
- Visual Basic(VBA) Excel vbaについての質問 3 2023/04/18 16:14
関連するカテゴリからQ&Aを探す
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
実行時エラー 438になった時の...
-
ADODB.Streamを使用してUTF-8を...
-
エクセルエラー13型が一致しま...
-
【Excel VBA】マクロをボタンに...
-
Excelで下記のようにマクロを作...
-
実行時エラー3001「引数が間違...
-
実行時エラー -'-2147417848
-
ExcelVBA Range クラスの Page...
-
EXCEL VBAマクロ中断でデバッグ...
-
VBS実行時エラー オブジェクト...
-
エラーでつまってます・・・お...
-
Application.ActiveInspectorで...
-
ACCESS2000VBAでエラー「型が一...
-
マクロについて教えてください...
-
VBで構造体を使うさ際の64k...
-
VBAのコードがエラーになっ...
-
ExcelのVBAのAutoFillの使い方...
-
1列目の何行目に検索文字がある...
-
VBSで変数の宣言はできないので...
-
OLEDB.NETで接続できない
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
実行時エラー 438になった時の...
-
エクセルエラー13型が一致しま...
-
【Excel VBA】マクロをボタンに...
-
なぜこんな初歩的なVBAのIf文で...
-
マクロについて教えてください...
-
実行時エラー3001「引数が間違...
-
VBAがブレークモードになっ...
-
ExcelVBA Range クラスの Page...
-
VBSで変数の宣言はできないので...
-
VBS実行時エラー オブジェクト...
-
OLEDB.NETで接続できない
-
プロシージャ名の取得
-
EXCEL VBAマクロ中断でデバッグ...
-
ADODB.Streamを使用してUTF-8を...
-
VBAでのエラー
-
実行時エラー48発生時のDLL特定...
-
Outlook.ApplicationをCreateOb...
-
VB6+SQL サーバー 2000 で 実行...
-
実行時エラー -'-2147417848
-
「コンパイルエラー:プロシー...
おすすめ情報
WindFallerさん、こんにちは
これまでにも、高度なテクニックを何度も教えていただいてお世話になっております
休日の貴重な時間に教えていただきありがとうございます
早速やってみます
報告までは時間がかかるかとおもいます
ありがとうございました
WindFallerさん、こんにちは。自己流ですがマクロできました。
Call GetSounddevice
If Range("G97") = "ON" Then
Application.Speech.Speak "テスト テスト", True
Else
MsgBox "SONY OFF"
End If
'MsgBox MesStr
Range("H37") = MesStr
'F97:接続機器(例えば SONY)
If InStr(Range("H37"), Range("F97")) Then
Range("G97") = "ON"
Else
Range("G97") = "OFF"
End If
文字数の制限で全て書けませんでしたので説明させてください
'MsgBox MesStr 以下は GetSounddeviceの自己流修正部分です
Range("G97") = "OFF"
End If
この下は
Set objClassSet = Nothing
Set objClass = Nothing
Set objService = Nothing
Set objLocator = Nothing
です
WindFallerさん、大変お世話になっております
自分なりにエラー処理をしているのですが、よくよく考えてみると
SONYのアンプがONかOFFか判断するよりも
「音を鳴らせるサウンドデバイスが1つ以上存在するか」というチェックができれば
これが一番簡単で機器変更にも対応できるエラー処理のような気がします
実際、一時SONYを修理に出してオンボードで鳴らしていた時期もありました
MsgBoxにSONYの文字が無くても、オンボードのサウンドが有効であれば問題ないかと思います
「音を鳴らせるサウンドデバイスが1つ以上存在するか」というチェックはマクロで
できるのでしょうか