Распознавание голоса в PowerPoint с использованием макросов VBA - PullRequest
Новая
       6

Распознавание голоса в PowerPoint с использованием макросов VBA

0 голосов
/ 11 мая 2018

Неделю назад у меня была презентация, где я делал ИИ, используя Voice Recognition с VBA. Он работал отлично (я взял код с этого сайта ), пока однажды я не собирался снова его протестировать, и он не работал. Возвращает ошибку

«Ошибка времени выполнения« 70 »: разрешение запрещено»

Я проверил свой микрофон и необходимые ссылки VBA, упомянутые на сайте. Затем я зашел на сайт, с которого взял код, и увидел другую версию кода (Public, Shared ...), и когда я его запустил, появляется другая ошибка

«Ошибка времени выполнения -2147200905 (80045077)»: ошибка автоматизации »

Так может кто-нибудь, пожалуйста, помогите мне, код работал, и я ничего не изменил. Вот код: 

Option Explicit

Dim WithEvents RC As SpInProcRecoContext
Dim Recognizer As SpInprocRecognizer
Dim myGrammar As ISpeechRecoGrammar

Private Sub CommandButton1_Click()

    'On Error GoTo EH

    Set RC = New SpInProcRecoContext
    Set Recognizer = RC.Recognizer

    Set myGrammar = RC.CreateGrammar
    myGrammar.DictationSetState SGDSActive

    Dim Category As SpObjectTokenCategory
    Set Category = New SpObjectTokenCategory
    Category.SetId SpeechCategoryAudioIn

    Dim Token As SpObjectToken
    Set Token = New SpObjectToken
    Token.SetId Category.Default()
    Set Recognizer.AudioInput = Token

'EH:
'    If Err.Number Then ShowErrMsg
End Sub




Private Sub RC_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult)
    On Error GoTo EH

    TextBox1.text = Result.PhraseInfo.GetText


EH:
    If Err.Number Then ShowErrMsg
End Sub


Private Sub ShowErrMsg()

    ' Declare identifiers:
    Const NL = vbNewLine
    Dim T As String

    T = "Desc: " & Err.Description & NL
    T = T & "Err #: " & Err.Number
    MsgBox T, vbExclamation, "Run-Time Error"
    'End

End Sub


'### Second version of the code (Shared, Public...)

        Option Explicit

    Public WithEvents RC As SpSharedRecoContext
    Public myGrammar As ISpeechRecoGrammar

    Private Sub CommandButton1_Click()
        'On Error GoTo EH

        Set RC = New SpSharedRecoContext

        Set myGrammar = RC.CreateGrammar
        myGrammar.DictationSetState SGDSActive

    'EH:
        'If Err.Number Then ShowErrMsg
    End Sub

    Private Sub RC_Recognition(ByVal StreamNumber As Long, ByVal StreamPosition As Variant, ByVal RecognitionType As SpeechLib.SpeechRecognitionType, ByVal Result As SpeechLib.ISpeechRecoResult)
        Label1.Caption = Result.PhraseInfo.GetText
    End Sub

    Private Sub RC_StartStream(ByVal StreamNumber As Long, ByVal StreamPosition As Variant)
        'Label2.Caption = Val(StreamNumber)
    End Sub

    Private Sub ShowErrMsg()

        ' Declare identifiers:
        Const NL = vbNewLine
        Dim T As String

        T = "Desc: " & Err.Description & NL
        T = T & "Err #: " & Err.Number
        MsgBox T, vbExclamation, "Run-Time Error"
        End

    End Sub

1 Ответ

0 голосов
/ 11 мая 2018

Эта ошибка говорит:

SPERR_RECOGNIZER_NOT_FOUND 0x80045077 -2147200905 Распознаватель не установлен.

...