Server : Apache/2.4.43 (Win64) OpenSSL/1.1.1g PHP/7.4.6 System : Windows NT USER-PC 6.1 build 7601 (Windows 7 Professional Edition Service Pack 1) AMD64 User : User ( 0) PHP Version : 7.4.6 Disable Function : NONE Directory : C:/Program Files (x86)/OpenOffice 4/share/basic/Gimmicks/ |
<?xml version="1.0" encoding="UTF-8"?> <!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd"> <!--*********************************************************** * * Licensed to the Apache Software Foundation (ASF) under one * or more contributor license agreements. See the NOTICE file * distributed with this work for additional information * regarding copyright ownership. The ASF licenses this file * to you under the Apache License, Version 2.0 (the * "License"); you may not use this file except in compliance * with the License. You may obtain a copy of the License at * * http://www.apache.org/licenses/LICENSE-2.0 * * Unless required by applicable law or agreed to in writing, * software distributed under the License is distributed on an * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY * KIND, either express or implied. See the License for the * specific language governing permissions and limitations * under the License. * ***********************************************************--> <script:module xmlns:script="http://openoffice.org/2000/script" script:name="ChangeAllChars" script:language="StarBasic">' This macro replaces all characters in a writer-documet through "x" or "X" signs. ' It works on the currently activated document. Private const UPPERREPLACECHAR = "X" Private const LOWERREPLACECHAR = "x" Private MSGBOXTITLE Private NOTSAVEDTEXT Private WARNING Sub ChangeAllChars ' Change all chars in the active document Dim oSheets, oPages as Object Dim i as Integer Const MBYES = 6 Const MBABORT = 2 Const MBNO = 7 BasicLibraries.LoadLibrary("Tools") MSGBOXTITLE = "Change All Characters to an '" & UPPERREPLACECHAR & "'" NOTSAVEDTEXT = "This document has already been modified: All characters will be changed to an " & UPPERREPLACECHAR & "'. Should the document be saved now?" WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document." On Local Error GoTo NODOCUMENT oDocument = StarDesktop.ActiveFrame.Controller.Model NODOCUMENT: If Err <> 0 Then Msgbox(WARNING & chr(13) & "First, activate a Writer document." , 16, GetProductName()) Exit Sub End If On Local Error Goto 0 sDocType = GetDocumentType(oDocument) If oDocument.IsModified And oDocument.Url <> "" Then Status = MsgBox(NOTSAVEDTEXT, 3+32, MSGBOXTITLE) Select Case Status Case MBYES oDocument.Store Case MBABORT, MBNO End End Select Else Status = MsgBox(WARNING, 3+32, MSGBOXTITLE) If Status = MBNO Or Status = MBABORT Then ' No, Abort End End If End If Select Case sDocType Case "swriter" ReplaceAllStrings(oDocument) Case Else Msgbox("This macro only works with Writer documents.", 16, GetProductName()) End Select End Sub Sub ReplaceAllStrings(oContainer as Object) ReplaceStrings(oContainer, "[a-z]", LOWERREPLACECHAR) ReplaceStrings(oContainer, "[à-þ]", LOWERREPLACECHAR) ReplaceStrings(oContainer, "[A-Z]", UPPERREPLACECHAR) ReplaceStrings(oContainer, "[À-ß]", UPPERREPLACECHAR) ReplaceStrings(oContainer, "[0-9]", UPPERREPLACECHAR) End Sub Sub ReplaceStrings(oContainer as Object, sSearchString, sReplaceString as String) oReplaceDesc = oContainer.createReplaceDescriptor() oReplaceDesc.SearchCaseSensitive = True oReplaceDesc.SearchRegularExpression = True oReplaceDesc.Searchstring = sSearchString oReplaceDesc.ReplaceString = sReplaceString oReplCount = oContainer.ReplaceAll(oReplaceDesc) End Sub</script:module>