Macros/Writer/005/es
Appearance
TDF LibreOffice Document Liberation Project Blogs comunitarios Weblate Nextcloud Redmine Ask LibreOffice Donar
Descripción
Esta macro pega el contenido del portapapeles como texto sin formato después de eliminar los saltos de línea y el estilo. Para usar esta macro de manera eficiente, puede agregar un atajo de teclado para la subrutina InsertClipboardTextInWriter()
en ▸ .
Para pegar solo texto sin formato desde el portapapeles, puede usar la macro general getClipboardText().
Código
' 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)," ") ' Reemplazar saltos de línea con espacios en blanco
sText = Replace (sText,Chr(13)," ") ' Reemplazar saltos de párrafo con espacios en blanco
WriteCursorPosition(sText) ' Pegar en Writer
End Sub ' InsertClipboardTextInWriter
Sub WriteCursorPosition(sText as String)
'''Esta subrutina se ha tomado de http://www.oooforum.org/forum/viewtopic.phtml?t=7540'''
'''Pegar texto en Writer en la posición del 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
'''Devuelve una cadena del texto del portapapeles actual'''
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