home *** CD-ROM | disk | FTP | other *** search
/ com!online 2001 December / COMCD1201.iso / openoffice / f_0177 / ChangeAllChars.xba < prev    next >
Encoding:
Extensible Markup Language  |  2001-04-25  |  6.5 KB  |  131 lines
  1. <?xml version="1.0" encoding="UTF-8"?>
  2.  
  3. <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.
  4. ' It works on the currently activated document.
  5. Private const UPPERREPLACECHAR = "X"
  6. Private const LOWERREPLACECHAR = "x"
  7.  
  8. Private MSGBOXTITLE
  9. Private NOTSAVEDTEXT
  10. Private WARNING
  11.  
  12. Sub ChangeAllChars   ' Change all chars in the active document
  13. Dim oSheets, oPages as Object
  14. Dim i as Integer
  15. Const MBYES = 6
  16. Const MBABORT = 2
  17. Const MBNO = 7
  18.         BasicLibraries.LoadLibrary("Tools")
  19.     Call SetLanguage
  20.  
  21.     On Local Error GoTo NODOCUMENT
  22.     oDocument = StarDesktop.ActiveFrame.Controller.Model
  23.     NODOCUMENT:
  24.     If Err <> 0 Then
  25.         Msgbox("This Macro extracts all Data of a displayed Writer-Document." & chr(13) & "Activate a Writer-Document!" , 16, "StarOffice 5.2")
  26.         Exit Sub
  27.     End If
  28.     On Local Error Goto 0
  29.  
  30.     sDocType = GetDocumentType(oDocument)
  31.  
  32.     If oDocument.IsModified And oDocument.Url <> "" Then
  33.         Status = MsgBox(NOTSAVEDTEXT, 3+32, MSGBOXTITLE)
  34.         Select Case Status
  35.             Case MBYES
  36.                 oDocument.Store
  37.             Case MBABORT, MBNO
  38.                 End
  39.         End Select
  40.     Else
  41.         Status = MsgBox(WARNING, 3+32, MSGBOXTITLE)
  42.         If Status = MBNO Or Status = MBABORT Then  ' No, Abort
  43.             End
  44.         End If
  45.     End If
  46.  
  47.     Select Case sDocType
  48.         Case "sWriter"
  49.             ReplaceAllStrings(oDocument)
  50.  
  51.         Case Else
  52.             Msgbox("This Macro only works with Writer-Documents!", 16, "StarOffice 5.2")
  53.     End Select
  54. End Sub
  55.  
  56.  
  57. Sub ReplaceAllStrings(oContainer as Object)
  58.     ReplaceStrings(oContainer, "[a-z]", LOWERREPLACECHAR)
  59.     ReplaceStrings(oContainer, "[├á-├╛]", LOWERREPLACECHAR)
  60.     ReplaceStrings(oContainer, "[A-Z]", UPPERREPLACECHAR)
  61.     ReplaceStrings(oContainer, "[├Ç-├ƒ]", UPPERREPLACECHAR)
  62.     ReplaceStrings(oContainer, "[0-9]", UPPERREPLACECHAR)
  63. End Sub
  64.  
  65.  
  66. Sub ReplaceStrings(oContainer as Object, sSearchString, sReplaceString  as String)
  67.     oReplaceDesc = oContainer.createReplaceDescriptor()
  68.     oReplaceDesc.SearchCaseSensitive = True
  69.     oReplaceDesc.SearchRegularExpression = True
  70.     oReplaceDesc.Searchstring = sSearchString
  71.     oReplaceDesc.ReplaceString = sReplaceString
  72.     oReplCount = oContainer.ReplaceAll(oReplaceDesc)
  73. End Sub
  74.  
  75.  
  76. Sub SetLanguage
  77. Dim ISOLanguage as String
  78.     ISOLanguage = StarDesktop.ISOLocale.Language
  79.  
  80.     Select Case ISOLanguage
  81.  
  82.         Case "en"
  83.             MSGBOXTITLE = "Change all characters to a '" & UPPERREPLACECHAR & "'"
  84.             NOTSAVEDTEXT = "This Document is modified: All characters are changed to an " & UPPERREPLACECHAR & "'. Shall the document be saved now?"
  85.             WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document."
  86.  
  87.         Case "fr"
  88.             MSGBOXTITLE = "Remplacer tous les caract├¿res par '" & UPPERREPLACECHAR & "'"
  89.             NOTSAVEDTEXT = "Le document a ├⌐t├⌐ modif├⌐, la macro remplacera tous les caract├¿res par '" & UPPERREPLACECHAR & "'. Enregistrer avant de proc├⌐der?"
  90.             WARNING = "La macro remplacera tous les caract├¿res et nombres par '" & UPPERREPLACECHAR & "' dans le document."
  91.  
  92.         Case "it"
  93.             MSGBOXTITLE = "Sostituire tutti i caratteri '" & UPPERREPLACECHAR & "'"
  94.             NOTSAVEDTEXT = "Il documento ├¿ stato modificato, la macro sostituer├á tutti i caratteri con '" & UPPERREPLACECHAR & "'. Salvare il documento prima di procedere?"
  95.             WARNING = "La macro sostituir├á tutti i caratteri e numeri con  '" & UPPERREPLACECHAR & "' nel documento attivo."
  96.  
  97.         Case "es"
  98.             MSGBOXTITLE = "Sustituir todos los caracteres por '" & UPPERREPLACECHAR & "'"
  99.             NOTSAVEDTEXT = "Este documento fue cambiado: todos los caracteres fueron sustituidos por " & UPPERREPLACECHAR & "'. Desea guardar el documento?"
  100.             WARNING = "Esta macro sustitue todos los caracteres y n├║meros en este documento por '" & UPPERREPLACECHAR & "'."
  101.  
  102.         Case "pt"
  103.             MSGBOXTITLE = "Substituir todos os caracteres por '" & UPPERREPLACECHAR & "'"
  104.             NOTSAVEDTEXT = "Este documento foi modificado: todos os caracteres foram substitu├¡dos por " & UPPERREPLACECHAR & "'. Deseja guardar o documento?"
  105.             WARNING = "Esta macro substitui todos os caracteres e n├║meros neste documento por '" & UPPERREPLACECHAR & "'."
  106.  
  107.         Case "nl"
  108.             MSGBOXTITLE = "Verander alle tekens in een'" & UPPERREPLACECHAR & "'"
  109.             NOTSAVEDTEXT = "Dit document is veranderd. Alle tekens zijn veranderd in een " & UPPERREPLACECHAR & "'. Wilt u het document nu opslaan?"
  110.             WARNING = "Dit macro verandert alle tekens en cijfers in een '" & UPPERREPLACECHAR & "' in dit document."
  111.  
  112.         Case "sv"
  113.             MSGBOXTITLE = "Byt ut alla bokst├ñver mot en '" & UPPERREPLACECHAR & "' "
  114.             NOTSAVEDTEXT = "Dokumentet har ├ñndrats, med detta makro kommer alla bokst├ñver att bytas ut mot en '" & UPPERREPLACECHAR & "' . Ska dokumentet s├ñkras/sparas innan?"
  115.             WARNING = "Makrot ers├ñtter alla bokst├ñver och tal i detta dokument med en '" & UPPERREPLACECHAR & "'."
  116.  
  117. '        Case "da"
  118.  
  119. '        Case "pl"
  120.  
  121. '        Case "ru"
  122.  
  123.         ' English & fallback/default
  124.         Case Else
  125.             MSGBOXTITLE = "Change all characters to a '" & UPPERREPLACECHAR & "'"
  126.             NOTSAVEDTEXT = "This Document is modified: All characters are changed to an " & UPPERREPLACECHAR & "'. Shall the document be saved now?"
  127.             WARNING = "This macro changes all characters and numbers to an '" & UPPERREPLACECHAR & "' in this document."
  128.     End Select
  129. End Sub
  130. </script:module>
  131.