Leer en voz alta texto de una hoja de cálculo mediante macros que ejecutan Balabolka

Keywords: Macro excel text to speech, Macro excel TTS, Macro excel texto a voz
Macros para ejecutar Balabolka desde OpenOffice Calc y Excel


Quizás te interese este post: "Pasar lista en clase con macros de excel y balabolka: automatizar control de asistencia en aula"

Se requiere instalar previamente la voz "Isabel" (ver el apartado "voces" en la web de Balabolka)

  • Primero la macro de OpenOffice Calc que lee en voz alta una lista de texto, visualizando la lista en la pantalla:
Sub Leer_lista
'ThisComponent.CurrentController hace referencia al documento activo. ActiveSheet es la hoja activa
oSheet = ThisComponent.CurrentController.ActiveSheet
'establecemos tiempo de pausa (milisegundos) entre lineas del listado, en este caso lo escribo en la celda B2, por ejemplo 1000
'Hay que tener en cuenta que es necesario buscar el código Ascii del caracter comillas dobles, que aparece en las etiquetas de pausa.
'Esto ha sido necesario porque da error cualquier otra forma de introducir directamente las comillas que van antes y despues del número en la etiqueta de tipo: <silence msec="2000"/>
'El código ascii de las comillas dobles es: 34
Pausa = "<silence msec=" & String(1,34) & oSheet.getCellRangeByName("B2").Value & String(1,34) & "/>"
'Nos quedamos con la referencia de la fila inicial, para volver al final
Dim FilaInicial as Object
oFilaInicial = ThisComponent.getCurrentSelection.getCellAddress.Row

'Ocultamos el procedimiento mediante el equivalente en Calc al ScreenUpdating = FALSE de Excel. De todos modos esto no parece hacer ningún cambio en mi caso.
ThisComponent.LockControllers      'Lock document update activity - stops screen updating
'seleccionamos el primer nombre de la lista que queremos leer. En este caso se trata de la celda AA3
ThisComponent.CurrentController.select(oSheet.getCellRangeByName("AA3"))
'escribimos archivo de texto
Dim iNumero As Integer
Dim aArchivo As String
'la siguiente ruta es de ejemplo
aArchivo = "C:\lista.txt"
iNumero = Freefile
Open aArchivo For Output As #iNumero
'establecemos las variables relacionadas con el movimiento del cursor
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(1) as new com.sun.star.beans.PropertyValue
args1(0).Name = "By"
args1(0).Value = 1
args1(1).Name = "Sel"
args1(1).Value = false
'escribimos filas hasta que encontremos la primera celda vacía
'escribo espacios en blanco para separar las etiquetas a la derecha de las palabras a leer en voz alta
Do While  ThisComponent.getCurrentSelection.String <>""
Print #iNumero, ThisComponent.getCurrentSelection.String & String(70 - Len(ThisComponent.getCurrentSelection.String), " ") & Pausa
'mover el cursor a la celda directamente inferior: seleccionamos la celda inferior
dispatcher.executeDispatch(document, ".uno:GoDown", "", 0, args1())
Loop
'cerramos el archivo de texto
Close #iNumero
'Volvemos a la fila inicial, la columna no es relevante, eligiendo la primera (corresponde al número 0)
ThisComponent.CurrentController.select(oSheet.getCellByPosition( 0,oFilaInicial ))

'Ejecutamos Balabolka, versión portable que en mi caso está en la siguiente ruta. Adaptar en cada caso
    Shell("F:\programas_portables\Balabolka\Balabolka_portable\balabolka.exe -rq C:\lista.txt Isabel",2)
'Mostramos el procedimiento
ThisComponent.UnlockControllers    'Unlock document update activity - re-enables screen updating
End Sub
  • La siguiente es una macro de OpenOffice Calc que lee la celda o celdas actualmente seleccionadas
sub texto_voz_portable_Isabel
dim document   as object
dim dispatcher as object
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
Shell("F:\programas_portables\Balabolka\Balabolka_portable\balabolka.exe -cmq Isabel",2)
end sub

  • Esta macro de Excel lee el contenido de las celdas activas (la celda o celdas actualmente seleccionadas). Puedes seleccionar una única celda o un rango. Con Windows Vista o 7 debemos desactivar el control de cuentas de usuario para que funcionen los comandos Application.SendKeys. Hai que reiniciar el equipo para que el cambio surta efecto.
    Desactivar UAC: Inicio, na casilla de búsqueda: “UAC” – Panel de Control – Cambiar configuración de control de cuentas de usuario: Desplazar a barra abajo de todo: “No notificarme nunca”
'Atención: previamente es necesario abrir el programa Balabolka y habilitar las teclas de acceso rápido globales
'OPCIONES - PARÁMETROS - FICHA "TECLAS RÁPIDAS"
'Marcar: "Usar teclas rápidas globales"
'las teclas de acceso rápido globales permiten leer texto en voz alta por Balabolka cuando cualquier otro programa está activo.
'Use global hotkeys: this means: when you press the global hotkey (for example, CTRL+ALT+F9) in any application Balabolka will read the text aloud from clipboard.


Function FileLocked(strFileName As String) As Boolean
' Check_process_running
' Esta función es para detectar si Balabolka se está ejecutando (archivo .exe bloqueado)
      On Error Resume Next
      ' If the file is already opened by another process,
      ' and the specified type of access is not allowed,
      ' the Open operation fails and an error occurs.
      Open strFileName For Binary Access Read Write Lock Read Write As #1
      Close #1
      ' If an error occurs, the document is currently open.
      If Err.Number <> 0 Then
         ' Display the error number and description.
         'MsgBox "Error #" & Str(Err.Number) & " - " & Err.Description
         FileLocked = True
         'Interesante limpar rexistro de erros
         Err.Clear
      End If
   End Function

Sub Texto_voz()
' Ctl + t
'Copiar al portapapeles
Selection.Copy

'Dependendo do ordenador, teño balabolka en distinta ruta
'Primeiro comprobamos si existe o arquivo nunha ruta e despois compromabos se está executándose (bloqueado)
Dim Archivo1, Archivo2 As String
Archivo1 = "C:\backup_my_passport\programas_portables\Balabolka\Balabolka_portable\balabolka.exe"
Archivo2 = "C:\Users\robertocm\Documents\backup_my_passport\programas_portables\Balabolka\Balabolka_portable\balabolka.exe"
'Para comprobar si exite archivo mediante a función Dir
Existe1 = Dir(Archivo1)
Existe2 = Dir(Archivo2)

'Esto para comprobar se o proceso se está executando
'http://support.microsoft.com/kb/184982/es
Dim strFileName As String
' Full path and name of file.
'Previamente esta declaración que usamos logo no comando Sendkeys
Set objShell = CreateObject("WScript.Shell")

'Comprobamos si existe arquivo na ruta do pc Acer
If Existe1 <> "" Then
'MsgBox "Existe arquivo na ruta especificada"
'Comprobamos si está executándose
'http://support.microsoft.com/kb/184982/es
' Call function to test file lock.
strFileName = Archivo1
If Not FileLocked(strFileName) Then
' If the function returns False, open the program
'Ejecutamos Balabolka portable
Shell "C:\backup_my_passport\programas_portables\Balabolka\Balabolka_portable\balabolka.exe -cm Isabel", vbMinimizedNoFocus
Else
        'Si está bloqueado, entón está xa executándose; lanzamos as teclas de acceso rápido
        'Leer en voz alta con teclas de acceso rápido globales: Ctl+Alt+F9
        'A primera liña non fai nada e está repetida, pero permíteme incorporar "Application"
        'E esto consigue que funcione perfectamente o seguinte
        'Si se quita tamén funciona, pero sae unha mensaxe en pantalla de desactivación do teclado numérico
        'Pode ser que con outros teclados, que non avisen en pantalla deste cambios non sexa necesario
        Application.SendKeys "^%{F9}", True
        objShell.SendKeys "^%{F9}" 'Ctl+Alt+F9
      End If
ElseIf Existe2 <> "" Then
'MsgBox "Existe arquivo na segunda ruta"
'Comprobamos si está executándose
'http://support.microsoft.com/kb/184982/es
' Call function to test file lock.
strFileName = Archivo2
If Not FileLocked(strFileName) Then
' If the function returns False, open the program
'Ejecutamos Balabolka portable
Shell "C:\Users\robertocm\Documents\backup_my_passport\programas_portables\Balabolka\Balabolka_portable\balabolka.exe -cm Isabel", vbNormalNoFocus
Else
        'Si está bloqueado, entón está xa executándose; lanzamos as teclas de acceso rápido
        'Leer en voz alta con teclas de acceso rápido globales: Ctl+Alt+F9
        'A primera liña non fai nada e está repetida, pero permíteme incorporar "Application"
        'E esto consigue que funcione perfectamente o seguinte
        'Si se quita tamén funciona, pero sae unha mensaxe en pantalla de desactivación do teclado numérico
        'Pode ser que con outros teclados, que non avisen en pantalla deste cambios non sexa necesario
        Application.SendKeys "^%{F9}", True
        objShell.SendKeys "^%{F9}" 'Ctl+Alt+F9
      End If
End If
End Sub

  • Esta macro de Excel lee el contenido de las celdas activas (la celda o celdas actualmente seleccionadas). Puedes seleccionar una única celda o una lista
Sub Leer_celdas_seleccionadas_texto_voz()
Application.CutCopyMode = False
Selection.Copy
ActiveCell.Select
'Ejecutamos Balabolka en modo minimizado y de lectura del portapapeles
'Aquí puede ser necesario cambiar "archivos de programa" por "program files" según las versiones de Windows
Shell "C:Archivos de programaBalabolkabalabolka.exe -cmq Isabel", vbNormalNoFocus
End Sub
  • Esta macro de Excel lee en con la voz en español toda una lista (que no contenga filas vacías en medio) que figure en la columna B de la hoja de cálculo (esto se puede cambiar, claro). Además hace una pausa entre cada línea de un número de milisegundos que se han escrito en la celda A1 (resumiendo: escribe, por ejemplo, el valor 400 en la celda A1, esta será la pausa entre líneas. A continuación escribes textos que se leerán en la columna B, empezando en B1).
Sub Leer_lista_texto_voz()
'Ocultamos el procedimiento
Application.ScreenUpdating = False
'Nos quedamos con la referencia de la celda en la que estamos al inicio, para volver al finalizar
Set CeldaInicial = ActiveCell
'Guardamos como cadena de texto el tiempo de pausa en milisegundos entre nombres
Dim Pausa As String
Pausa = "<silence msec=""" & ActiveSheet.Range("A1") & """/>"
'seleccionamos la primera celda de la lista a leer
Range("B1").Select
'escribimos arquichivo de texto
Dim strArchivoTexto As String
Dim f As Integer
'nombre y ruta del archivo de texto
strNombreArchivo = "Leer_listado_excel.txt"
strRuta = ThisWorkbook.Path & "\"
strArchivoTexto = strRuta & strNombreArchivo
'abrimos el archivo para escribir
f = FreeFile
Open strArchivoTexto For Output As #f
'escribimos al archivo
' rellenamos con espacios en blanco para alinear las etiquetas a la derecha
Do Until ActiveCell.Value = ""
Print #f, ActiveCell & String(70 - Len(ActiveCell), " ") & Pausa
ActiveCell.Offset(1, 0).Range("A1").Select
Loop
'cerramos el archivo de texto
Close f
'Ejecutamos Balabolka
'Aquí puede ser necesario cambiar "archivos de programa" por "program files" según las versiones de Windows
Shell "C:\archivos de programa\Balabolka\balabolka.exe -rq " & ThisWorkbook.Path & "\Leer_listado_excel.txt" & " Isabel", vbNormalNoFocus
'Volvemos a la celda en la que estábamos al inicio
ActiveSheet.Range(CeldaInicial.Address()).Select
'Mostramos la actualización de pantalla
Application.ScreenUpdating = True
End Sub

  • Si preferimos que Balabolka se ejecute minimizado, cambiariamos simplemente:
Shell "C:\archivos de programa\Balabolka\balabolka.exe -rmq " & ThisWorkbook.Path & "\Leer_listado_excel.txt" & " Isabel", vbNormalNoFocus


  • Esta macro para usuarios "avanzados". Funciona con Senkeys por lo que en Windows 7 hai que desactivar la UAC. La ventaja es que va más rápida, porque no inicia y cierra el programa cada vez que se lee en voz alta: 

Sub Texto_voz()
Selection.Copy
AppActivate "Microsoft Excel"
On Error Resume Next
AppActivate "Balabolka - [Documento1]"
  If Err = 0 Then
  Application.Wait (Now + TimeValue("0:00:1"))
    'Leer el portapapeles en voz alta: F9
    Application.SendKeys "{F9}", True
   
  Else: Shell "C:\Users\robertocm\Documents\backup_my_passport\programas_portables\Balabolka\Balabolka_portable\balabolka.exe -c Isabel", vbNormalNoFocus
  Application.Wait (Now + TimeValue("0:00:9"))
  End If
AppActivate "Microsoft Excel"
End Sub
 

1 comentario:

Anónimo dijo...

Interesante!!! Muchas gracias!! Saludos!!