Macro para separar texto en párrafos

[raul8salazar]

¡Hola a todos!

Estoy usando una macro para pegar texto sin formato en Writer. Me gustaría poder agregarle la capacidad de separar el texto que pega la macro en párrafos de 4 líneas o 70 palabras. La macro que estoy usando es la siguiente y se encuentra en este enlace:

' Copyright (c) 2011 Frieder Delor, Mailto: delorfr@googlemail.com
'
'    This program is free software: you can redistribute it and/or modify
'    it under the terms of the GNU General Public License as published by
'    the Free Software Foundation, either version 3 of the License, or
'    (at your option) any later version.
'
'    This program is distributed in the hope that it will be useful,
'    but WITHOUT ANY WARRANTY; without even the implied warranty of
'    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
'    GNU General Public License for more details.
'
'    You should have received a copy of the GNU General Public License
'    along with this program.  If not, see <http://www.gnu.org/licenses/>.

Option Explicit

Sub InsertClipboardTextInWriter()
    Dim sText As String
    sText= (getClipboardText)
    sText = Replace (sText,Chr(10)," ") ' Replace line breaks with white spaces
    sText = Replace (sText,Chr(13)," ") ' Replace paragraph breaks with white spaces
    WriteCursorPosition(sText) ' Paste in Writer
End Sub ' InsertClipboardTextInWriter


Sub WriteCursorPosition(sText as String)
    '''This sub is taken from http://www.oooforum.org/forum/viewtopic.phtml?t=75409'''
    '''Paste text in Writer at the position of the cursor'''

    Dim oViewCursor As Object ' com.sun.star.text.XTextViewCursor
    Dim oText As Object
    oViewCursor = ThisComponent.GetCurrentController.ViewCursor
    If IsEmpty(oViewCursor.Cell) Then
        oText = ThisComponent.text
    Else
        oText = oViewCursor.Cell.Text
    End If
    oText.insertString(oViewCursor, sText, false)

End Sub ' WriteCursorPosition


Function getClipboardText() As String
    '''Returns a string of the current clipboard text'''

    Dim oClip As Object ' com.sun.star.datatransfer.clipboard.SystemClipboard
    Dim oConverter As Object ' com.sun.star.script.Converter
    Dim oClipContents As Object
    Dim oTypes As Object
    Dim i%

    oClip = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
    oConverter = createUnoService("com.sun.star.script.Converter")
    On Error Resume Next
    oClipContents = oClip.getContents
    oTypes = oClipContents.getTransferDataFlavors

    For i = LBound(oTypes) To UBound(oTypes)
        If oTypes(i).MimeType = "text/plain;charset=utf-16" Then
            Exit For
        End If
    Next

    If (i >= 0) Then
        On Error Resume Next
        getClipboardText = oConverter.convertToSimpleType _
            (oClipContents.getTransferData(oTypes(i)), com.sun.star.uno.TypeClass.STRING)
    End If

End Function ' getClipboardText

Lo que quiero lograr es lo siguiente:

1. Copiar el texto deseado desde el navegador.
2. Usar la macro para que:
   2.1 Tome el texto desde el portapapeles.
   2.2 Limpie el formato que tenga.
   2.3 Lo pegue donde está el cursor en el documento (hasta este punto todo lo hace la macro que está en el enlace sin problemas).
3. Que la macro también divida el texto pegado en párrafos cada cuatro líneas o cada 70 palabras (esto es lo que me gustaría agregar a la macro y no sé cómo hacerlo).

¿Alguna sugerencia de cómo lograrlo?

[Kyodake]

Sub pegarTextoSinFormato()
    Dim oDoc As Object
    Dim oClipboard As Object
    Dim sText As String
    Dim aParrafos() As String
    Dim nIndex As Integer
    Dim nContador As Integer

    'Obtiene el documento actual
    oDoc = ThisComponent

    'Obtiene el texto desde el portapapeles
    oClipboard = createUnoService("com.sun.star.datatransfer.clipboard.SystemClipboard")
    sText = oClipboard.getContents().getTransferData("text/plain;charset=UTF-16").Value

    'Elimina el formato del texto
    sText = Replace(sText, Chr(13), "")

    'Dividir el texto en párrafos cada cuatro líneas
    aParrafos = Split(sText, Chr(10))
    nIndex = 0
    nContador = 0
    For i = 0 To UBound(aParrafos)
        If nContador >= 4 Then
            nContador = 0
            aParrafos(nIndex) = aParrafos(nIndex) & Chr(10)
            nIndex = nIndex + 1
        End If
        If nIndex = 0 Then
            aParrafos(nIndex) = aParrafos(i)
        Else
            aParrafos(nIndex) = aParrafos(nIndex) & aParrafos(i)
        End If
        nContador = nContador + 1
    Next

    'Pegar el texto en el documento
    Dim oCursor As Object
    oCursor = oDoc.CurrentController.getViewCursor()
    oCursor.getText().insertString(oCursor, Join(aParrafos, Chr(10)), False)
End Sub
`

[raul8salazar]

¡Muchas gracias por tu respuesta!

Al intentar usar la macro me aparece un error que no pude descifrar (aunque la verdad es que entiendo muy poco sobre BASIC y mi investigación en internet fue infructuosa).

¿Tendrías idea de por qué tengo este error al usar la macro?

[Kyodake]

Prueba cambiar la línea por esta:

sText = oClipboard.getContents().getTransferData("text/plain").Value

Con esta línea obtienes el contenido del portapapeles sin especificar la codificación:

[raul8salazar]

Hice el cambio y me da el mismo error en el mismo lugar

[Kyodake]

Verifica que un documento de LibreOffice está abierto antes de ejecutar la macro.

Si no hay un documento abierto, abre uno y luego intenta ejecutar la macro nuevamente.

Verifica que la línea oDoc = ThisComponent está en la parte superior de la macro y que está escrita correctamente.

Verifica que el contenido del portapapeles se puede leer correctamente.

O

Siendo que la primera parte de la macro primitiva que has escrito, funcionaba correctamente, pruébala con este agregado:

Option Explicit

Sub InsertClipboardTextInWriter()
Dim sText As String
sText= (getClipboardText)
sText = Replace (sText,Chr(10)," “)
sText = Replace (sText,Chr(13),” ")
sText = SplitText(sText) ’ Divide el texto en párrafos
WriteCursorPosition(sText) ’ Pega el texto en Writer
End Sub ’ InsertClipboardTextInWriter

Sub WriteCursorPosition(sText As String)
Dim oViewCursor As Object ’ com.sun.star.text.XTextViewCursor
Dim oText As Object
oViewCursor = ThisComponent.GetCurrentController.ViewCursor
If IsEmpty(oViewCursor.Cell) Then
oText = ThisComponent.text
Else
oText = oViewCursor.Cell.Text
End If
oText.insertString(oViewCursor, sText, false)
End Sub ’ WriteCursorPosition

Function getClipboardText() As String
Dim oClip As Object ’ com.sun.star.datatransfer.clipboard.SystemClipboard
Dim oConverter As Object ’ com.sun.star.script.Converter
Dim oClipContents As Object
Dim oTypes As Object
Dim i%
oClip = createUnoService(“com.sun.star.datatransfer.clipboard.SystemClipboard”)
oConverter = createUnoService(“com.sun.star.script.Converter”)
On Error Resume Next
oClipContents = oClip.getContents
oTypes = oClipContents.getTransferDataFlavors
For i = LBound(oTypes) To UBound(oTypes)
If oTypes(i).MimeType = “text/plain;charset=utf-16” Then
Exit For
End If
Next
If (i >= 0) Then
On Error Resume Next
getClipboardText = oConverter.convertToSimpleType _
(oClipContents.getTransferData(oTypes(i)), com.sun.star.uno.TypeClass.STRING)
End If
End Function ’ getClipboardText

Function SplitText(sText As String) As String
Dim aParagraphs As Variant
Dim i As Integer, j As Integer
Dim wordsCount As Integer
Dim paragraph As String
aParagraphs = Split(sText, vbCrLf) ’ Dividir el texto en líneas
For i = 0 To UBound(aParagraphs)
paragraph = “”
wordsCount = 0
Do While i <= UBound(aParagraphs) And (wordsCount < 70 Or j Mod 4 <> 0)
If Trim(aParagraphs(i)) <> “” Then
paragraph = paragraph & aParagraphs(i) & " "
wordsCount = wordsCount + UBound(Split(aParagraphs(i), " ")) + 1
j = j + 1
End If
i = i + 1
Loop
i = i - 1
SplitText = SplitText & paragraph & vbCrLf
Next
End Function ’ SplitText

La función agregada SplitText, básicamente, divide el texto en párrafos cada cuatro líneas o cada 70 palabras, y devuelve el texto dividido como una cadena de caracteres.
Luego, la función WriteCursorPosition pega el texto en Writer.

[raul8salazar]

Agradezco mucho la ayuda aunque finalmente no logré hasta ahora hacer que la macro funcione como quiero. No sé dónde está mi error. Si logro algún avance más lo pondré en el siguiente comentario.