Hello,
> -----Original Message-----
> From: The weird writer [mailto:[email protected]]
> Sent: Monday, July 15, 2013 6:09 PM
> To: [email protected]
> 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), "==>")
replaceArray = array("&", """, "<" , ">" , "'",
"'==>")
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: [email protected]
For additional commands, e-mail: [email protected]
