MS Excel: Editor hlasové syntézy (pro vpm, poi, apod.)

Diskuze o software, který má mnoho společného s touto značkou (MapSource, BaseCamp, POI Loader, WebUpdater a ostatní).

Re: MS Excel: Editor hlasové syntézy (pro vpm, poi, apod.)

Odeslatod Path » 21.04.11 11:27 (Čt)

Ok, rozumím. VBA si můžete upravit například tak, aby se názvy generovaly podle vámi zadaných hodnot uvedených ve sloupci D v listě TEXT. Úprava kódu mohla vypadat nějak takto (upravená procedura ProgressVoice):

vba Code: Vybrat vše
'------------------------------------------------------
' čtení textu
'------------------------------------------------------
Sub ProgressVoice(aSentence As Variant, Optional mode As Byte = 1)
 Dim oVoice       As Object                                       ' deklarace objektu SpVoice
Dim oFSTRM       As Object                                       ' deklarace objektu SpFileStream
Dim iVoiceItem   As Integer                                      ' deklarace proměnné pro typ hlasu
Dim iVolume      As Integer                                      ' deklarace proměnné pro úroveň hlasitosti
Dim iRate        As Integer                                      ' deklarace proměnné pro úroveň tempa
Dim iAudioFormat As Integer                                      ' deklarace pro audio formát (wav)
Dim iRadio       As Integer                                      ' deklarace proměnné pro položku volby TTS v MENU
Dim iColumn      As Integer
 Dim iRow         As Integer
 Dim iNumbering   As Integer
 Dim bNumbering   As Boolean
 Dim iFileDef     As Byte
 Dim iFormat      As Byte
 Dim sFileDef     As String
 Dim sText        As String
 Dim sPath        As String
 Dim sFile        As String
 Dim sTmp         As String
 Dim flag         As Byte
 Dim i            As Integer
 
   On Error GoTo ErrHandler                                       ' návěstí pro zachytávání chyb
     
   With ThisWorkbook.Sheets(SHVOICES)                             ' předvolby z listu VOICES
     iVoiceItem = .Range(RNG_VOICE_ITEM) - 1                     ' zvolená hlasová syntéza
     iVolume = .Range(RNG_VOICE_VOLUME)                          ' zvolená hlasitost
     iRate = .Range(RNG_VOICE_RATE) - 10                         ' zvolené tempo hlasu
     iAudioFormat = .Range(RNG_AUDIO_FORMAT)                     ' typ formátu wav
  End With
   With ThisWorkbook.Sheets(SHSAPI)                               ' předvolby z listu MENU
     If .Shapes("rdb_1").ControlFormat.Value = 1 Then            ' předvolby pro čtení / zápis textu
        iRadio = 1
         flag = SVSFLAGSASYNC                                     ' čteme vše
     ElseIf .Shapes("rdb_2").ControlFormat.Value = 1 Then
         iRadio = 2
         flag = SVSFISXML + SVSFLAGSASYNC                         ' aplikujeme tagy bbcode (TTS)
     Else
         iRadio = 3
         flag = SVSFLAGSASYNC                                     ' čteme text kromě definice tagů bbcode (TTS)
     End If
     
      If mode = 2 Or mode = 4 Then                                ' pouze pokud se jedná o zápis
        sPath = fceGetOutFolder                                  ' nastavíme cestu, kam se budou soubory zapisovat
        If IsFolderExists(sPath) = False Then Error 50010        ' pokud je cesta neplatná, ukončíme
        Select Case .Shapes("rdb_file1").ControlFormat.Value
            Case 1
               iFileDef = 1                                       ' název souboru: podle textu
           Case Else
               iFileDef = 2                                       ' název souboru: vlastní
              If fceCheckValidCustomFileName = False Then GoTo Finish    ' validace vlastního názvu souboru
              sFileDef = Trim(.Range("file_custom_name"))        ' sFileDef bude obsahovat šablonu pro název souboru
              iFormat = fceCountOfSpecificChars(sFileDef, "#")   ' pro formátování inkrementace názvu souboru
              If .Shapes("chb_counter").ControlFormat.Value = 1 Then
                  iNumbering = Val(.Range("file_custom_numbering"))  ' vlastní index číslování
              Else
                  iNumbering = 0
               End If
               bNumbering = IIf(iNumbering <= 0, False, True)
         End Select
         If iAudioFormat = 1 Then                                 ' pro výstupní formát wav (podle stahovacího seznamu)
           iAudioFormat = 0
         Else
            iAudioFormat = iAudioFormat + 2
         End If
      End If
     
   End With
   
   ' nastavíme objekt SAPI, včetně tempa a hlasitosti
  Set oVoice = CreateObject("SAPI.SpVoice")
   
   With oVoice
      Set .voice = oVoice.GetVoices().item(iVoiceItem)
      .volume = iVolume
      .Rate = iRate
   End With
   
   Select Case mode                                               ' podle typu výstupu...
     
   Case 1
     
      ' čteme všechny označené buňky
     With ThisWorkbook.Sheets(SHOUT)
         For i = LBound(aSentence) To UBound(aSentence)
            sText = Trim(.Cells(aSentence(i), COL_READ))          ' naplníme proměnnou sText aktuálním řádkem
           Select Case iRadio
               Case 2
                  sText = fceSVSFConvertToXML(sText, False)       ' převod bbcode na TTS tagy
              Case 3
                  sText = fceSVSFConvertToXML(sText, True)        ' odstranění bbcode
           End Select
            If Len(sText) <> 0 Then                               ' text s nulovou délkou ignorujeme
              With Application
                  .StatusBar = "Čte se řádek: " & aSentence(i)    ' ve stavovém řádku zobrazíme číslo aktuálního řádku
                 .EnableCancelKey = xlErrorHandler               ' možnost přerušení pomocí ESC
              End With
               With oVoice
                  .Speak sText, flag                              ' čtení
                 Do
                  Loop Until .WaitUntilDone(10)                   ' čekáme na konec (v této smyčce je možné čtení přerušit pomocí ESC)
                 '.WaitUntilDone (INFINITE)
              End With
            End If
         Next
      End With
     
   Case 2
     
      ' zapíšeme všechny označené buňky
     Set oFSTRM = CreateObject("SAPI.SpFileStream")              ' nastavíme objekt SpFileStream
     oFSTRM.Format.Type = iAudioFormat                           ' zvolený formát audia (wav)
     With ThisWorkbook.Sheets(SHOUT)
         For i = LBound(aSentence) To UBound(aSentence)
            sText = Trim(.Cells(aSentence(i), COL_READ))          ' naplníme proměnnou sText aktuálním řádkem
           If Len(sText) <> 0 Then                               ' text s nulovou délkou ignorujeme
             
'               Select Case iFileDef
'                  Case 1
'                     sTmp = fceSVSFConvertToXML(sText, True)      ' odstraníme tagy
'                     sTmp = fcePrepareFilename(sTmp, 255)         ' připravíme název souboru z textu
'                  Case 2
'                     If bNumbering = True Then                    ' připravíme název souboru podle šablony
'                        sTmp = fceGetCustomFileName(sFileDef, _
'                        iNumbering, iFormat)                      ' vlatní číslování
'                        iNumbering = iNumbering + 1
'                     Else
'                        sTmp = fceGetCustomFileName(sFileDef, _
'                        aSentence(i), iFormat)                    ' číslování podle řádků
'                     End If
'               End Select
              sTmp = Trim(.Cells(aSentence(i), COL_FILE + 1))
               Select Case iRadio
                  Case 2
                     sText = fceSVSFConvertToXML(sText, False)    ' převod bbcode na TTS tagy
                 Case 3
                     sText = fceSVSFConvertToXML(sText, True)     ' odstranění bbcode
              End Select
 
               sFile = sPath & sTmp & ".wav"                      ' definujeme název souboru včetně cesty a přípony
             
               oFSTRM.Open sFile, SSFMCreateForWrite, True        ' otevřeme stream pro zápis do souboru
              Set oVoice.AudioOutputStream = oFSTRM              ' objektu SpVoice definujeme výstup do streamu
             
               With Application
                  .StatusBar = "Čte se řádek: " & aSentence(i)    ' ve stavovém řádku zobrazíme číslo aktuálního řádku
                 .EnableCancelKey = xlErrorHandler               ' možnost přerušení pomocí ESC
              End With
               With oVoice
                  .Speak sText, flag                              ' zápis čtení do souboru
                 Do
                  Loop Until .WaitUntilDone(10)                   ' čekáme na konec (v této smyčce je možné čtení přerušit pomocí ESC)
              End With
               
               oFSTRM.Close                                       ' zavřeme stream
              .Cells(aSentence(i), COL_FILE) = sTmp              ' do příslušného sloupce zapíšeme název souboru bez cesty a bez přípony
           End If
         Next
      End With
     
   Case 3
         
      ' čteme všechny buňky ve sloupci
     For i = 1 To UBound(aSentence) - 1
         sText = Trim(aSentence(i, 1))
         If Len(sText) <> 0 Then
            Select Case iRadio
               Case 2
                  sText = fceSVSFConvertToXML(sText, False)       ' převod bbcode na TTS tagy
              Case 3
                  sText = fceSVSFConvertToXML(sText, True)        ' odstranění bbcode
           End Select
            With Application
               .StatusBar = "Čte se řádek: " & i + ROW_FIRST - 1  ' do stavovém řádku uvedeme číslo řádku, se kterým se pracuje
              .EnableCancelKey = xlErrorHandler                  ' možnost přerušení pomocí ESC
           End With
            With oVoice
               .Speak sText, flag                                 ' čteme text
              Do
               Loop Until .WaitUntilDone(10)                      ' v této smyčce je možné čtení přerušit pomocí ESC
           End With
         End If
      Next
   
   Case 4
     
      ' zapíšeme všechny buňky ve sloupci
     Set oFSTRM = CreateObject("SAPI.SpFileStream")              ' nastavíme objekt SpFileStream
     oFSTRM.Format.Type = iAudioFormat                           ' zvolený formát audia (wav)
     For i = 1 To UBound(aSentence) - 1
         sText = Trim(aSentence(i, 1))                            ' naplníme proměnnou sText z pole aSentence
        If Len(sText) <> 0 Then                                  ' text s nulovou délkou ignorujeme
'            Select Case iFileDef
'               Case 1
'                  sTmp = fceSVSFConvertToXML(sText, True)         ' odstraníme tagy
'                  sTmp = fcePrepareFilename(sTmp, 255)            ' připravíme název souboru z textu
'               Case 2
'                  If bNumbering = True Then                       ' připravíme název souboru podle šablony
'                     sTmp = fceGetCustomFileName(sFileDef, _
'                     iNumbering, iFormat)                         ' vlatní číslování
'                     iNumbering = iNumbering + 1
'                  Else
'                     sTmp = fceGetCustomFileName(sFileDef, _
'                     i + ROW_FIRST - 1, iFormat)                  ' číslování podle řádků
'                  End If
'            End Select
           
            ' čteme hodnoty ze sloupce D:
           sTmp = Trim(ThisWorkbook.Sheets(SHOUT).Cells(i + ROW_FIRST - 1, COL_FILE + 1))
            Select Case iRadio
               Case 2
                  sText = fceSVSFConvertToXML(sText, False)       ' převod bbcode na TTS tagy
              Case 3
                  sText = fceSVSFConvertToXML(sText, True)        ' odstranění bbcode
           End Select
 
            sFile = sPath & sTmp & ".wav"                         ' definujeme název souboru včetně cesty a přípony
           oFSTRM.Open sFile, SSFMCreateForWrite, True           ' otevřeme stream pro zápis do souboru
           Set oVoice.AudioOutputStream = oFSTRM                 ' objektu SpVoice definujeme výstup do streamu
             
            With Application
               .StatusBar = "Čte se řádek: " & i + ROW_FIRST - 1  ' ve stavovém řádku zobrazíme číslo aktuálního řádku
              .EnableCancelKey = xlErrorHandler                  ' možnost přerušení pomocí ESC
           End With
            With oVoice
               .Speak sText, flag                                 ' zapíšeme do souboru
              Do
               Loop Until .WaitUntilDone(10)                      ' v této smyčce je možné čtení přerušit pomocí ESC
           End With
            oFSTRM.Close                                          ' zavřeme stream a zapíšeme do sloupce C
           ThisWorkbook.Sheets(SHOUT).Cells(i - 1 + ROW_FIRST, COL_FILE) = sTmp
         End If
      Next
     
   End Select
   
Finish:
   
   With Application
      .EnableCancelKey = xlInterrupt                              ' výchozí chování kláves ESC, Pause + Break
     .StatusBar = False                                          ' resetujeme status bar
  End With
   If IsObject(oFSTRM) Then Set oFSTRM = Nothing                  ' uklidíme po sobě
  Set oVoice = Nothing
 
Exit Sub
ErrHandler:
 
   Select Case Err.Number
      Case 18                                                     ' vynucené přerušení procedury
        oVoice.Speak vbNullString, SVSFPURGEBEFORESPEAK
         MsgBox "Přerušili jste proceduru.", vbExclamation, "Zastaveno"
         Resume Finish
      Case 432
         sMsg = "Nelze zapsat do souboru:" & vbCrLf & vbCrLf & _
            sFile & vbCrLf & vbCrLf & "Soubor se již používá nebo nemáte oprávnění k zápisu do této složky."
      Case -2147200967
         sMsg = "Pravděpodobně jste zadali chybný index hlasu (" & iVoice & ")" & vbCrLf & vbCrLf & _
            "Chyba č.:" & Err.Number & vbCrLf & vbCrLf & "Popis chyby: " & Err.Description
      Case 50010
         sMsg = "Definovaná cesta pro zápis souborů není platná:" & vbCrLf & vbCrLf & sPath & _
             vbCrLf & vbCrLf & "V " & SHSAPI & " definujte platnou cestu."
      Case Else
         sMsg = "Vyskytla se chyba č.:" & Err.Number & vbCrLf & vbCrLf & "Popis chyby: " & Err.Description
   End Select
   
   MsgBox sMsg, vbCritical, "Chyba"
   Resume Finish
End Sub ' ==>> ProgressVoice


Název pro jeden soubor bude řešit tento řádek:
sTmp = Trim(.Cells(aSentence(i), COL_FILE + 1))

a pro více souborů tento řádek:
sTmp = Trim(ThisWorkbook.Sheets(SHOUT).Cells(i + ROW_FIRST - 1, COL_FILE + 1))
Obrázek uživatele
Path
Site Admin
 
Příspěvků: 3406
Registrace: 15.05.07 23:15 (Út)

Re: MS Excel: Editor hlasové syntézy (pro vpm, poi, apod.)

Odeslatod zdzd » 21.04.11 12:34 (Čt)

Dík za náměty, třeba se na to vrhnu.
zdzd
 
Příspěvků: 90
Registrace: 03.09.09 9:32 (Čt)

Re: MS Excel: Editor hlasové syntézy (pro vpm, poi, apod.)

Odeslatod Path » 21.04.11 12:37 (Čt)

V podstatě uděláte jen CTRL+C a pak CTRL+V :)
Obrázek uživatele
Path
Site Admin
 
Příspěvků: 3406
Registrace: 15.05.07 23:15 (Út)

Re: MS Excel: Editor hlasové syntézy (pro vpm, poi, apod.)

Odeslatod zdzd » 21.04.11 16:46 (Čt)

Prověřeno, funguje.

Díky
zdzd
 
Příspěvků: 90
Registrace: 03.09.09 9:32 (Čt)

Předchozí

Zpět na Garmin: Software

Kdo je online

Online uživatelé v tomto fóru: CommonCrawl [Bot] a 2 návštevníci.