openoffice-dev mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From Jörg Schmidt <joe...@j-m-schmidt.de>
Subject Re: autocorrect macro?
Date Mon, 15 Jul 2013 22:10:31 GMT
Hello, 

> -----Original Message-----
> From: The weird writer [mailto:weirdwriter9891@gmail.com] 
> Sent: Monday, July 15, 2013 6:09 PM
> To: dev@openoffice.apache.org
> Subject: Re: autocorrect macro?
> 
> when I try i get a weird error. extract faied 42

I do not know what should be "weird error".

In addition, you are rude and uncooperative. No "thank you", no evidence of your operating
system, etc.

This code works fine for me (OOo 3.3.0, Windows 7). 

global gWriterDoc as object
global gCalcDoc as object
global autoCorrDbDatFileWithPath as string
global autoCorrFileXmlWithPath as string


sub ImportACLfromWord   
   ' ImportACLfromWord - 23/06/2006 by Pat B
   ' Modifications 25/06/2006 by Zarius (refactored & generalised)
   
   ' ** Back up your //.openoffice.org2/user/autocorr/acor_xx-xx.dat before you start.
    
   ' Use MS Word to back up your Word autocorrect list using the macro at
   '   http://word.mvps.org/FAQs/Customization/ExportAutocorrect.htm
   ' Then open that document in Writer, run this macro then restart OpenOffice.

   ' Tested on OOo 2.0.2 on Linux (Ubuntu 6.0.6) - locale en-AU
   ' Tested on StarOffice 7.0 on Linux (RHEL 4)  - locale en-AU
   ' "Should" be general enough to work on any OS that OO works on.

   ' Before running, uncomment the appropriate version below and
   ' replace the locale (OO1.x: 1033, OO2.x: en-AU) with your locale.
   ' New: the macro should automatically detect the locale on OO2.x

   ' **********************************************************************
   ' ******************** EDIT ME *****************************************
   ' SO7/OO1.x
   'locale = "1033" ' SO7, OO1.x - other locales have different numbers (eg 1031)
   'autoCorrDbDatFile = "acor"+locale+".dat" ' this probably wont change   

   ' OO2.x
   'locale = "en-AU"   ' en-AU = Australian English (change to your own locale)
   locale = detectSetupSystemLocale() ' automatic detection - only for OO2.x
   autoCorrDbDatFile = "acor_"+locale+".dat" ' this probably wont change
   ' ******************** END: EDIT ME ************************************
   ' **********************************************************************

   ' The macro selects the unformatted entries (ie RTF='False' elements) in MS
   '   Word's AutoCorrect Backup Document and transposes these to a text document
   '   called DocumentList.xml which is then zipped into
   '   //.openoffice.org2/user/autocorr/acor_en-AU.dat.

   ' It does not transpose formatted entries.  I suggest you do this manually.

   ' Good luck!  No Warranty!

   dim oWriterDocFrame, oCalcDocFrame as object
   dim dispatcher as object
   dim vcursor, txtype as object
   dim msg, seln as string
   Dim CalcDoc As Object
   Dim CalcUrl As String
   Dim OpenDummy()
   dim GoRLUD(1) as new com.sun.star.beans.PropertyValue
   dim gotoCell(1) as new com.sun.star.beans.PropertyValue
   dim TypeText(0) as new com.sun.star.beans.PropertyValue

   autoCorrFileXml = "DocumentList.xml"     ' this probably wont change

   ' setup the path and filenames for the AutoCorrect database and the xml file
   oPaths = CreateUnoService( "com.sun.star.util.PathSettings" )
   sofficeConfigPathUrl = oPaths.UserConfig
   sofficeConfigPath = ConvertFromURL(sofficeConfigPathUrl) ' strip the file:/// from the
front
   autoCorrDbDatFileWithPath = sofficeConfigPathUrl + "/../autocorr/" + autoCorrDbDatFile
   autoCorrFileXmlWithPath   = sofficeConfigPathUrl + "/../autocorr/" + autoCorrFileXml

   ' setup the dispatcher (note: trying to phase out the dispatcher commands,
   '    though probably need it for the copy & paste at the least)
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

   ' ---------------- writer section

   ' grab the current document
   gWriterDoc = ThisComponent
   oWriterDocFrame = gWriterDoc.CurrentController.Frame
   
   ' If the table is large, these steps can take minutes.  Pls be patient.
   
   ' TODO: work out a way of doing this (deleting top two lines) using the
   '   API whilst not leaving one paragraph hanging at the top of the document.

   ' make sure we're right at the top of doc, need all three of these
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())

   ' del first two lines then go to top again
   GoRLUD(0).Name = "Count"
   GoRLUD(0).Value = 1
   GoRLUD(1).Name = "Select"
   GoRLUD(1).Value = true
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoDown", "", 0, GoRLUD())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:Delete", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:Delete", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())

   ' check you are now in a table and abort if not.
   vCursor = ThisComponent.currentcontroller.getViewCursor()
   textType = ThisComponent.Text.createEnumeration().NextElement
   if ( not(textType.supportsService("com.sun.star.text.TextTable")) ) then
      msg = "You don't seem to be in a table.                    " & _
         chr(10) & "The open document should be the AutoCorrect Backup Document " &
_
         chr(10) & "      created by MS Word" & _
         chr(10) & "The macro may need tweaking." & _
         chr(10) & "Aborting......"
      msgbox ( msg, 0, "ERROR!")
      exit sub
   endif

   ' get the rows and columns of the table, so we can remove bits we don't need
   oTables = gWriterDoc.getTextTables()
   oTable = oTables.getByName("Tabelle1")
   oRows = oTable.getRows()
   oColumns = oTable.getColumns()
   
   ' loop through all rows and remove those that have "True" in the third column
   ' (note: a for loop seems easier, but didn't work well due to a shrinking row count)
   rowCount = oRows.Count
   i = 0
   while (i < rowCount)
      cellName = "C"+trim(str(i+1))
      cellLeftVal = oTable.getCellByName("A"+trim(str(i+1))).String
      if(oTable.getCellByName(cellName).String = "True") then
         oRows.removeByIndex(i, 1)
         i = i-1
         rowCount = rowCount - 1
      endif
      i = i+1
   wend
   
   ' delete header row and third column (true/false column)
   oRows.removeByIndex(0,1)
    if (oColumns.Count > 2) then
       oColumns.removeByIndex(2, 1)
   endif

   ' replace special characters with their appropriate xml representations
   searchArray =  array(chr(38),  chr(34), chr(60), chr(62), chr(39), "==&gt;")
   replaceArray = array("&amp;", "&quot;", "&lt;" , "&gt;" , "&apos;",
"'==&gt;")
   searchAndReplaceArrays(gWriterDoc, searchArray(), replaceArray())

   ' back to the top again
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:GoToStartOfDoc", "", 0, Array())

   'check you are still in a table and abort if not.
   if ( not(textType.supportsService("com.sun.star.text.TextTable")) ) then
      msg = "You don't seem to be in a table." & _
         chr(10) & "The macro may need tweaking." & _
         chr(10) & "Aborting macro......"
      MsgBox ( msg, 0, "ERROR!")
      exit sub
   endif

   ' select the entire remaining table and copy it to clipboard

   dispatcher.executeDispatch(oWriterDocFrame, ".uno:SelectTable", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:Copy", "", 0, Array())

   ' close the writer document as we no longer need it
   ' (commenting this out while testing can make life easier)
   gWriterDoc.close(true)

   ' ---------------- spreadsheet section

   ' open a blank spreadsheet to assemble our new xml file into
   gCalcDoc = StarDesktop.loadComponentFromURL( "private:factory/scalc", "_blank", 0, Array()
)
   calcDocFrame = gCalcDoc.CurrentController.Frame

   ' Fill first 2 lines with the xml header text   
   currentSheet = gCalcDoc.getCurrentController().getActiveSheet()
   oRange = currentSheet.getCellRangeByName("A1")
   oRange.setString("<?xml version=""1.0"" encoding=""UTF-8""?>")
   oRange = currentSheet.getCellRangeByName("A2")
   oRange.setString("<block-list:block-list xmlns:block-list=""http://openoffice.org/2001/block-list"">")

   ' If the table is large, these steps can also take minutes.  Pls be patient.

   ' Fill columns B & D by pasting the two table cols & inserting a col between them
   oRange = currentSheet.getCellRangeByName("B3")
   gCalcDoc.getcurrentcontroller().Select(oRange)
   dispatcher.executeDispatch(calcDocFrame, ".uno:Paste", "", 0, Array())

   oColumns = currentSheet.Columns
   oColumns.insertByIndex(2, 1)
   
   ' Fill columns A, C & E
   fillColumn("A", 3, " <block-list:block block-list:abbreviated-name=""")
   fillColumn("C", 3, """ block-list:name=""")
   fillColumn("E", 3, """/>")
   
   saveCalcFile() ' We now have the Word replacement list saved as DocumentListPart1
   calcDocFrame.close(true) ' Clean up by closing the spreadsheet
   joinAcLists()  ' Append the new list to the top of the current list
   msgbox "Successfully merged the word ac list with OpenOffice.  You will need to restart
OpenOffice to see the changes.", 0, "Success."
end sub

sub saveCalcFile()
   dim SaveFileAs(3) as new com.sun.star.beans.PropertyValue

   oPaths = CreateUnoService( "com.sun.star.util.PathSettings" )
   sofficeConfigPath = oPaths.UserConfig
   
   dim arr_x(1) as new com.sun.star.beans.PropertyValue
   arr_x(0).Name = "FilterName"
   arr_x(0).Value = "Text - txt - csv (StarCalc)"
   arr_x(1).Name = "FilterOptions"
   arr_x(1).Value = "0,0,76,0"

   'Save As Text
   sFileUrl = sofficeConfigPath + "/../autocorr/DocumentListPart1"
   'oArgs = Array(MakePropertyValue( "FilterName", "Text - txt - csv (StarCalc)" ),MakePropertyValue(
"FilterOptions", "0,0,76,0" ))
    gCalcDoc.storeToURL( sFileUrl, arr_x() )
end sub

sub joinAcLists()
   'We are constructing a new DocumentList.xml with Word's replacement list at top.  Then
ALL of
   '  Writer's existing replacement list entries underneath.  Otherwise we lose Writer's formatted
   '  autocorrect entries.  So we have a lot of duplicates which Writer will automatically
remove
   '  at the next change to its replacement table.  Second duplicate is the one discarded,
hence we
   '  put the Word list at the top.
   oPaths = CreateUnoService( "com.sun.star.util.PathSettings" )
   sofficeConfigPathUrl = oPaths.UserConfig

   oUcb = createUnoService("com.sun.star.ucb.SimpleFileAccess")
   if (not(oUcb.Exists(autoCorrDbDatFileWithPath))) then
      msgbox "Error: autocomplete file ("+autoCorrDbDatFileWithPath+") is missing."
      end ' stop program completely
   endif

   if (oUcb.getSize(autoCorrDbDatFileWithPath) = 0) then
      msgbox "Error: autocomplete file is empty, this macro doesn't handle that yet."
      end ' stop program completely
   endif

   ' unzip the document.xml out of the auto correct db file
   unzipAutoCorrDB()

   ' open both the new word AC list and our OO AC list (DocumentList.xml)
   wordACListDocument = sofficeConfigPathUrl + "/../autocorr/DocumentListPart1"
   oWordAcWriterDoc = StarDesktop.loadComponentFromURL( wordACListDocument, "_blank", 0, Array()
)
   oOoAcWriterDoc = StarDesktop.loadComponentFromURL( autoCorrFileXmlWithPath, "_blank", 0,
Array() )

   ' search and replace a few times to cut the xml header away (since it's in the new file)
   oRD = oOoAcWriterDoc.createReplaceDescriptor()
   
   oRD.searchRegularExpression = false
   oRD.SearchString = "<?xml version=""1.0"" encoding=""UTF-8""?>"
   oRD.ReplaceString = ""
   oOoAcWriterDoc.ReplaceAll(oRD)
   
   oRD.SearchString = "<block-list:block-list xmlns:block-list=""http://openoffice.org/2001/block-list"">"
   oOoAcWriterDoc.ReplaceAll(oRD)

   ' get rid of the blank paragraph remaining at the top
   oRD.searchRegularExpression = true
   oRD.SearchString = "^$"
   oOoAcWriterDoc.ReplaceAll(oRD)

   ' copy the contents of the Word AC list and paste into the OO AC list
   oWriterDocFrame = oWordAcWriterDoc.getCurrentController().getFrame()
   dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:SelectAll", "", 0, Array())
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:Copy", "", 0, Array())
   oWriterDocFrame = oOoAcWriterDoc.getCurrentController().getFrame()
   dispatcher.executeDispatch(oWriterDocFrame, ".uno:Paste", "", 0, Array())

   ' save the OO AC list and close the documents
   oOoAcWriterDoc.Store()
   oWordAcWriterDoc.close(true)
   oOoAcWriterDoc.close(true)

   ' remove the word ac list
   kill wordACListDocument
   
   ' zip the OO AC list (document.xml) back into the auto correct db dat file
   zipAutoCorrDB()
end sub

' This function will search through the document and replace anything in the
'   document that matches entries in the searchArray with the relevant
'   entry in the replaceArray.
function searchAndReplaceArrays(oDocument, searchArray, replaceArray)
   dim oReplace as object
   oReplace = ThisComponent.createReplaceDescriptor()
   oReplace.SearchCaseSensitive = True
   For i = LBound(searchArray()) To UBound(searchArray())
      oReplace.SearchString = searchArray(i)
      oReplace.ReplaceString = replaceArray(i)
      ThisComponent.ReplaceAll(oReplace)
   Next i
end function

' simple function to make this procedure look a little neater
function setStruct(struct, strName, value)
   struct.Name = strName
   struct.Value = value
end function

' Given a top cell location of a given column it will fill from the given row
'   to the last used row with the value in cellString.
function fillColumn(topCol, topRow, cellString)   
   ' assemble our cell references
   topCell = topCol & trim(str(topRow))
   lastRow = getLastUsedRow(gCalcDoc.getCurrentController.getActiveSheet())
   bottomCell = topCol & trim(str(lastRow+1)) ' +1 is needed
   rangeName = topCell + ":" + bottomCell
   
   ' grab the dataArray from the required range and fill with the val in cellString
   oSheet = gCalcDoc.getCurrentController().getActiveSheet()
   oRange = oSheet.getCellRangeByName(rangeName)
   dataArray = oRange.getDataArray()
   For i = LBound(dataArray) To UBound(dataArray)
      aRow = dataArray(i)
      For j = LBound(aRow) to UBound(aRow)
         aRow(j) = cellString
      Next j
      dataArray(i) = aRow
   Next i

   ' write the data array back to the spreadsheet
   oRange.setDataArray( dataArray() )
end function

' simply return the value of the last row with data in it in the given sheet
function getLastUsedRow(oSheet as Object) as Integer
  Dim oCell As Object
  Dim oCursor As Object
  Dim aAddress As Variant
  oCell = oSheet.GetCellbyPosition( 0, 0 )
  oCursor = oSheet.createCursorByRange(oCell)
  oCursor.GotoEndOfUsedArea(True)
  aAddress = oCursor.RangeAddress
  GetLastUsedRow = aAddress.EndRow
end function

' thanks to al_andreas for the original zip and unzip autocorrdb functions
sub zipAutoCorrDB()
   dim zipService as variant
   dim filestreamService as variant
   dim inputStream as variant
   dim theZipper as variant
   dim outputStream as variant
   
   Dim args1(0)

   args1(0) = autoCorrDbDatFileWithPath

   filestreamService = createUnoService("com.sun.star.ucb.SimpleFileAccess")
   inputStream = FilestreamService.OpenFileRead(autoCorrFileXmlWithPath)

   zipService = createUnoService("com.sun.star.packages.Package")
   zipService.initialize(args1())

   theZipper=zipService.createInstance()
   theZipper.SetInputStream(inputStream)

   autoCorrFileXml = FileNameoutofPath(autoCorrFileXmlWithPath)
   outputStream=zipService.getByHierarchicalName("")

   outputStream.replaceByName(autoCorrFileXml, theZipper)

   zipService.commitChanges()

   kill autoCorrFileXmlWithPath
end sub

' thanks to al_andreas for the original zip and unzip autocorrdb functions
sub unzipAutoCorrDB()   
   dim zipService as variant
   dim filestreamService as variant
   dim inputStream as variant
   dim theZipper as variant
   dim outputStream as variant
   dim autoCorrFileXml as string
   dim args1(0)

   args1(0) = autoCorrDbDatFileWithPath
   
   zipService = createUnoService("com.sun.star.packages.Package")
   zipService.initialize(args1())
   
   autoCorrFileXml = FileNameoutofPath(autoCorrFileXmlWithPath)
   theZipper = ZipService.getByHierarchicalName(autoCorrFileXml)
   inputStream = TheZipper.getInputStream()
   
   outputStream = createUnoService("com.sun.star.ucb.SimpleFileAccess")
   outputStream.WriteFile(autoCorrFileXmlWithPath, inputStream)
End Sub

' Simple function to grab the string description of the currently set locale
function detectSetupSystemLocale() as string
   Dim currentLocale as string   
   Dim oSettings, oConfigProvider
   Dim oParams(0) As new com.sun.star.beans.PropertyValue
   
   oConfigProvider = createUnoService( "com.sun.star.configuration.ConfigurationProvider"
)
   oParams(0).Name = "nodepath"
   oParams(0).Value = "/org.openoffice.Setup/L10N"
   oSettings = oConfigProvider.createInstanceWithArguments("com.sun.star.configuration.ConfigurationAccess",
oParams() )
   currentLocale= oSettings.getbyname("ooSetupSystemLocale")   
   detectSetupSystemLocale() = currentLocale   
end function


'Retrieves the mere filename out of a whole path
Function FileNameoutofPath(ByVal Path as String, Optional Separator as String) as String
Dim i as Integer
Dim SepList() as String
	If IsMissing(Separator) Then
		Path = ConvertFromUrl(Path)
		Separator = GetPathSeparator()		
	End If
	SepList() = ArrayoutofString(Path, Separator,i)
	FileNameoutofPath = SepList(i)
End Function




No further comment on my part.


Greetings,
Jörg



---------------------------------------------------------------------
To unsubscribe, e-mail: dev-unsubscribe@openoffice.apache.org
For additional commands, e-mail: dev-help@openoffice.apache.org


Mime
View raw message