マクロの実行途中で「応答なし」が発生する

下記のマクロは、以前このサイトで教えて頂いたものです。
毎日のように使用しているのですが、最近、windows10をアップデートした頃から、マクロを実行している途中で「応答なし」になり、表示画面が一時的に真っ白になります。
「応答なし」を回避する方法を教えて下さい。

Excel2013を使用してます。

PCは、i7-4600U CPU@2.10GHzです。

下記のマクロの使い方は、sheet2のA列に英文、B列に日本語訳を入れてマクロを実行させると、sheet1に、その英文、日本語訳が表示され、読み上げてくれるものです。



https://oshiete.goo.ne.jp/qa/9302799.html





'----------標準モジュール------------
Private Declare Sub Sleep Lib "kernel32.dll" (ByVal dwMilliseconds As Long)


'//
Sub SettingVoice2()
Dim Voice As SpVoice
Dim s1 As String, s2 As String
Dim DispSh As Worksheet
Dim DataSh As Worksheet
'表示シート1[Worksheets("Sheet1")]で使う
Set DispSh = Worksheets("Sheet1")
'データシート[Worksheets("Sheet2")]のA2 から、下に入れていく。
Set DataSh = Worksheets("Sheet2")
Set Voice = New SpVoice 'テキスト・スピーチ TTS インスタンス
Const SPD As Long = 50 '通常50～200まで　★
Dim bln As Boolean
Dim sw As Boolean: sw = False '日英切り替えスイッチ★★
With DispSh
.Range("C4, C6").ClearContents
If bln = False Then
With .Range("C4, C6").Font
If .Size < 12 Then
.Size = 16
.Bold = True
bln = True
End If
End With
End If
End With
If sw Then
Voice.Speak "さあ　英単語を覚えましょう"
Else
Voice.Speak "<xml><lang langid=""409"">learn the next words by heart</lang></xml>" '英語
End If
With DataSh
For j = 2 To .Cells(Rows.Count, 1).End(xlUp).Row
If sw Then
s1 = .Cells(j, 2).Value: s2 = .Cells(j, 1).Value
Else
s1 = .Cells(j, 1).Value: s2 = .Cells(j, 2).Value
End If
For i = 1 To Len(s1)
Sleep SPD
DispSh.Range("C4").Value = Mid(s1, 1, i)
DoEvents
Next i
Application.ScreenUpdating = False
If sw Then
Voice.Speak s1 '日本語
Else
Voice.Speak "<xml><lang langid=""409"">" & s1 & "</lang></xml>" '英語
End If
Application.ScreenUpdating = True
Sleep 100
For i = 1 To Len(s2)
Sleep SPD
DispSh.Range("C6").Value = Mid(s2, 1, i)
DoEvents
Next i
Application.ScreenUpdating = False
If sw Then
Voice.Speak "<xml><lang langid=""409"">" & s2 & "</lang></xml>" '英語
Else
Voice.Speak s2 '日本語
End If
Application.ScreenUpdating = True
Sleep 10
DispSh.Range("C4,C6").ClearContents
Next j
End With
If sw Then
Voice.Speak "おつかれさまでした。"
Else
Voice.Speak "<xml><lang langid=""409"">Thank you for listening</lang></xml>" '英語
End If
Set Voice = Nothing
End Sub

質問者からの補足コメント

• PCを初期化して、アプリを再インストールしたら、直るでしょうか？

    補足日時：2017/05/05 20:26

No.2 回答者： WindFaller 回答日時： 2017/05/09 12:04

DreamsComeFalse1様

そのコードの作者です。ずっとお使いになられたと知り、ありがたく存じます。
やっとこちらでも試してみましたが、特に不具合は見当たりません。
ただし、ご質問のコードは、簡易バージョンのものをお使いのようです。
様々な暴走を止めるためのプログラムがほとんど入っていないようですが、私がどんな根拠があって、そのようなコードを書いたのか、今は思い出せないでいます。

>PCを初期化して、アプリを再インストールしたら、直るでしょうか？
それは、あまり期待できません。
できれば、ブック自体を新しくして、マクロ側は、暴走防止入りのコードと、シートはCtrl +A ->Ctrl +C でコピーオールして、新規シートに貼り付けるということをしてみてはいかがかと思います。

次に、一度、Microsoft Speech Object Library を疑ってみる必要があるかもしれません。

C:\Windows\System32\Speech\Common\sapi.dll 2016/07/16 PM 5:25
Ver. 5.3.19915.00

私の方は、Windows 10 にアップグレードした後に、PCが立ち上がらなくなり、OSの再インストールしたお陰で、この音声周りは、半年以上にもなるのに、まだ復旧していません。

もともと、これは、AT & T の外部音声エンジンでこちらは試していたもので、現行のSeakVoiceは、まったく不満足な状態なのです。しかし、私が従来使っていたエンジンは、もう15年以上も前ですから、日本語も英語も買い直したいのですが、二つだけでも7,000円は掛かるもので、こちらが思うものを日本語を含めて全部揃えると、2万円近くになってしまい、今は、躊躇してしまっています。

当面の対処の仕方は、

Const SPD As Long = 100 '通常50～200まで　★
この数字を増やしてみるというのはいかがでしょうか。

それに、暴走を止めるためのいくつかの手立てが、そのコードにはありません。

本来は、私のオリジナルや環境を含めた仕様をお渡ししたほうがよいのですが、今の所、自分のみの仕様にしてありますので、さて、どうしたものかと思っています。

なお、前回、話は中途だった気がします。あまり細かなリクエストまでは到底背負いきれなかったからです。

私自身は、単語そのものからの、システム的な利用を考えていたので、コクヨのメモリボ・リスニーやかつての神ツールP-Study sytem を使っていること、単語リストは、Quizlet から、自動的に単語リストを抜き出す方法、『学辞郎』から、単語集やイディオム集を私独自の抜き出す方法、さらに、NHKの語学サイトから、トピック英文をダウンロードする方法など、いろいろなものを考え出しています。
この背景には、シャープの『翻訳これ一番』やIBMの『翻訳の王様』のユーティリティが使えなくなったのが遠因しています。特に、シャープの『翻訳……』のユーティリティは、私のリクエストを採用していただいたこともあり、大変に気に入っていました。

No.1 回答者： goold-man 回答日時： 2017/05/05 18:24

1)ハードウェアグラフィックアクセラレータの無効化：Excel起動、「ファイル」「オプション」「詳細設定」「表示」「ハードウェアグラフィックアクセラレータを無効にする」にチェックを入れる。

駄目なら、
2)マルチスレッドを無効：「ファイル」「オプション」「詳細設定」数式の「マルチスレッド計算を行う」のチェックをオフ、及び「全般」「マルチスレッド処理を有効にする」のチェックをオフ。
駄目なら、
3）Officeを修復：Officeの「プログラム削除」「アンインストーラー」「削除」か「変更」で「変更」を選び、「修復」を選ぶ。
4）Officeのアップデート（過去の不具合/バグ等をアップデートで修正していることがある）
http://tsuyozi.com/1027.html

この回答へのお礼

ご回答有難う御座います。
１～４まで全て試しましたが、効果なしです。
どうしたら良いでしょうか？

お礼日時：2017/05/05 20:22