マクロ/Writer/005
Appearance
TDF LibreOffice Document Liberation Project Community Blogs Weblate Nextcloud Redmine Ask LibreOffice Donate
説明
このマクロは、改行とスタイル設定を削除した後、クリップボードから書式設定されていないテキストとして内容を貼り付けます。このマクロを効率的に使用するには、InsertClipboardTextInWriter()
のキーボードショートカットを追加します。
クリップボードから書式設定されていないテキストのみを貼り付けるには、汎用マクロ getClipboardText() を使用します。
Code
' 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)," ") ' 改行を空白に置き換える
sText = Replace (sText,Chr(13)," ") ' 段落の区切りを空白に置き換える
WriteCursorPosition(sText) ' Writerに貼り付け
End Sub ' InsertClipboardTextInWriter
Sub WriteCursorPosition(sText as String)
'''このマクロは http://www.oooforum.org/forum/viewtopic.phtml?t=75409 から引用しています'''
'''Writerのテキストをカーソルの位置に貼り付け'''
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