For countless reasons, batch changes may have to be made in text documents. This is valid, for example, when anonymizing a document is required.
"theDupontDurand.odt" is an example of text with some typographic formatting. The example suggests that the names of persons and places should be replaced, for example before being communicated to a third party.
The file "batchSearchReplace.ods" contains the data to replace and TWO buttons to go in a direction of replacement, or its reciprocal. We act on a Writer file that can be chosen from a drop-down list and a button allows you to refresh the names and addresses of Writer files if their openings are made after the Calc file.
The macro offer the advantage of a talking beetween documents specific to Open/LibreOffice but whose nature is different. Here, Calc is used almost as a dialog box that would allow to enter a very large amount of data that Writer makes use of. And, to do this, it also makes the inventory of open files and on which it can act. Knowledge of this principle can bring good fruits in other situations than this one. The modules of the office suite are already very powerful; But the relationship that can be established between them really multiplies the possibilities that macros allow. I have already treated the subject elsewhere in another context (Draw ⇄ Calc); But it's in French. I do a translation (bad, I know ) if asked...
The Code :
Code: Select all
Option Explicit
' ╔══════════════════════════════════════════════════════════════════════════════╗
' ║ Find and replace instances in text files "Writer". ║█
' ╚══════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Sub batchSearchReplace(evt)
Dim myDocumentS As Object, myDocument As Object, theCollection As Object
Dim mySheet As Object, myForm As Object, replace As Object
Dim myReplacements(1, 1000) As String, myString As String, myButton As String
Dim i As Integer, j As Integer
mySheet = thisComponent.currentController.ActiveSheet ' All occurrences are stored in memory.
myForm = mySheet.drawPage.forms.getByName("myForm")
myString = mySheet.getCellByPosition(1, 13).String
myButton = evt.source.model.name
i = 0
While myString <> "" ' Loop as long as a cell is not empty.
myReplacements(0, i) = myString
myReplacements(1, i) = mySheet.getCellByPosition(2, 13 + i).String
i = i + 1
myString = mySheet.getCellByPosition(1, 13 + i).String
Wend
theCollection = starDesktop.components.createEnumeration ' Search for open files which replacements should be done.
On Error Goto Next_1: ' In order to avoid pseudos empty windows.
While theCollection.hasMoreElements
myDocumentS = theCollection.nextElement
If myDocumentS.url = convertToURL(mySheet.getCellRangeByName("$B$10").String) Then
myDocument = myDocumentS
myDocumentS.currentController.frame.getContainerWindow.setFocus
Next_1:
End If
Wend
replace = myDocument.CreatereplaceDescriptor() ' Effective replacement.
For j = 0 to (i - 1)
With replace
Select Case myButton ' Direction of replacement.
Case "B_to_C" : .searchString = myReplacements(0, j) : .replaceString = myReplacements(1, j)
Case "C_to_B" : .searchString = myReplacements(1, j) : .replaceString = myReplacements(0, j)
End Select
Select Case myForm.getByName("regExpress" ).state ' Regular expression required.
Case 0 : .searchRegularExpression = False
Case 1 : .searchRegularExpression = True
End Select
Select Case myForm.getByName("caseSensitive").state ' Case sensitive required.
Case 0 : .searchCaseSensitive = False
Case 1 : .searchCaseSensitive = True
End Select
End With
myDocument.replaceAll (replace())
Next j
End Sub
' ╔══════════════════════════════════════════════════════════════════════════════╗
' ║ List Open Files. ║█
' ╚══════════════════════════════════════════════════════════════════════════════╝█
' ▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀▀
Sub listOpenFiles As String
Dim myDocumentS As Object, theCollection As Object, mySheet As Object
Dim i As Integer, j As Integer, myLine As Integer
Dim nameFile(255) As String
Dim B10_OK As Boolean
theCollection = starDesktop.components.createEnumeration
mySheet = thisComponent.currentController.ActiveSheet
B10_OK = False
i = 0 : myLine = 3
On Error Goto Next_2: ' In order to avoid pseudos empty windows.
While theCollection.hasMoreElements
myDocumentS = theCollection.nextElement
' Avoids the macro IDE and help windows.
If (( len(myDocumentS.url ) <> 0 ) And _
( left(myDocumentS.url, 20) <> "vnd.sun.star.help://") And _
(right(myDocumentS.url, 4 ) = ".odt") _
) Then
i = i + 1
nameFile(i) = convertFromUrl(myDocumentS.url)
' The $B$10 cell contains the file address.
If mySheet.getCellRangeByName("$B$10").String = nameFile(i) Then B10_OK = True
Next_2:
End If
Wend
If (i >= 0) Then ' The opposite happens when no file is opened.
Redim Preserve nameFile(i) ' Resize the table for the drop-down list.
For j = 1 to i
mySheet.getCellByPosition(4, myLine + j - 1).String = nameFile(j) ' Effective allocation.
Next j
End If
For j = i + 1 to i + 30 ' Emptying Cells Beneath.
mySheet.getCellByPosition(4, myLine + j - 1).String = ""
Next j
If Not B10_OK Then mySheet.getCellRangeByName("$B$10").String = "" ' Dump the $B$10 cell if its value was not found in the list.
End Sub