1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
|
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<!--
* This file is part of the LibreOffice project.
*
* This Source Code Form is subject to the terms of the Mozilla Public
* License, v. 2.0. If a copy of the MPL was not distributed with this
* file, You can obtain one at http://mozilla.org/MPL/2.0/.
*
* This file incorporates work covered by the following license notice:
*
* 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 .
-->
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="ChangeAllChars" script:language="StarBasic">' This macro replaces all characters in a writer-document 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>
|