This macro isn’t ideal solution, but maybe better than nothing. It gets words without duplicities from the document (via collection), then it spellchecks ones, and then it will write all incorrect words to new document.
Set the constants cLang and cCountry in the start to your language and test it. The constant cWord is definition of word by regular expression, now there is alphanumeric characters and dot and dash.
Sub dictExample 'write all incorrect words from spellcheck to new document
const cLang="en"
const cCountry="US"
const cDict="standard.dic"
'getDictionaries 'show dictionaries for the constant cDict
const cWord="([:alnum:]|[.-])+" 'definition of word by regular expression -> alfanumeric character or dot or dash
dim oDoc0 as object, oDoc as object, s$, sOut$, oHledani as object, oHledaniParam as object, oNalez, oStart, oEnd, a&, b&, _
col as new collection, sText0$, oSpeller as object, oDics as object, oDic as object, oLoc as new com.sun.star.lang.Locale, i&, _
oDlg as object, oPrubeh as object, oButton as object, iKrok%
oDoc0=ThisComponent
for i=1 to oDoc0.DrawPage.Count 'text from Text Boxes, Frames, Shapes
sText0=sText0 & chr(13) & oDoc0.DrawPage.getByIndex(i-1).String
next i
sText0=sText0 & chr(13) & oDoc0.Text.String 'text from document
oHledani=CreateUnoService("com.sun.star.util.TextSearch")
oHledaniParam=CreateUnoStruct("com.sun.star.util.SearchOptions")
with oHledaniParam
.algorithmType=com.sun.star.util.SearchAlgorithms.REGEXP 'regular expression
.searchString=cWord 'word
end with
oHledani.setOptions(oHledaniParam)
oNalez=oHledani.searchForward(sText0, b, len(sText0)) 'search string
oDlg=progressBarInit(0, len(sText0), oDoc0) 'progressbar
oPrubeh=oDlg.getControl("Pprogress") : oButton=oDlg.getControl("Pbutton")
on local error resume next
do while oNalez.subRegExpressions>0
a=oNalez.startOffset(0) 'start position in string
b=oNalez.endOffset(0) 'end position in string
s=mid(sText0, a+1, b-a)
col.add(s, s) 'GET WORDS WITHOUT DUPLICITIES
iKrok=iKrok+1
b=b+1
oNalez=oHledani.searchForward(sText0, b, len(sText0)) 'search string
if iKrok=300 then
oPrubeh.Value=a 'set value to progressbar
iKrok=0
end if
if oButton.Model.State=1 then
oDlg.dispose()
exit sub
end if
loop
oDlg.dispose()
on local error goto 0
oSpeller=createUnoService("com.sun.star.linguistic2.SpellChecker") 'spellchecker
oDics=createUnoService("com.sun.star.linguistic2.DictionaryList") 'list of the dictionaries
'xray oDics.Dictionaries 'list of the dictionaries
oDic=oDics.getDictionaryByName(cDict) 'use the dictionary
with oLoc
.Language=cLang
.Country=cCountry
end with
for i=1 to col.Count
s=col(i)
if NOT oSpeller.isValid(s, oLoc, array()) then
sOut=sOut & s & chr(13)
end if
next i
if sOut<>"" then 'write incorrect words into new document
oDoc=StarDesktop.LoadComponentFromUrl("private:factory/swriter", "_blank", 0, array())
oDoc.lockControllers
oDoc.Text.String=sOut
oDoc.unlockControllers
else
msgbox "No incorrect words found :-)"
end if
End Sub
Function progressBarInit(min&, max&, optional oDoc as object) as object 'vrátí objekt dialogového okna; při chybějícím oDoc ho přichytí k Desktopu
on local error goto chyba
dim oDlg as object, oDlgModel as object, oButtonModel as object, oProgress as object, oWindow as Object
dim oSize as object, oSiz as new com.sun.star.awt.Size, koef as double
const iDlgWidth=140, iDlgHeight=45 'bacha, nejde o pixely jako kdyby se vytvářelo dialogové okno v Basic editoru a pak volalo; dále je pro vystředění okna použita metoda convertSizeToPixel a nastavena proměnná koef
rem model dialogového okna
oDlgModel=CreateUnoService("com.sun.star.awt.UnoControlDialogModel")
with oDlgModel
.Width=iDlgWidth
.Height=iDlgHeight
end with
rem ukazatel průběhu
oProgress=oDlgModel.createInstance("com.sun.star.awt.UnoControlProgressBarModel") 'objekt ukazatele průběhu
with oProgress
.Name="Pprogress" 'jméno pro makro
.ProgressValueMin=min 'minimum
.ProgressValueMax=max 'maximum
.ProgressValue=0 'aktuální hodnota
.Width=120
.Height=15
.positionX=10
.positionY=5
.Border=3 'rámeček
end with
oDlgModel.insertByName("Pprogress", oProgress) 'přidat do modelu
rem tlačítko Zrušit
oButtonModel=oDlgModel.createInstance("com.sun.star.awt.UnoControlButtonModel")
with oButtonModel
.Name="Pbutton"
.Width=40
.Height=15
.PositionX=50
.PositionY=25
.Label="Cancel"
.PushButtonType=com.sun.star.awt.PushButtonType.STANDARD
.TabIndex=0
.Toggle=true 'aktivace detekce vlastnosti State tlačítka
end with
oDlgModel.insertByName("Pbutton", oButtonModel)
rem vykreslení dialogového okna
oDlg=CreateUnoService("com.sun.star.awt.UnoControlDialog") 'dialog
oDlg.visible=false 'skrýt dialog ať neproblikává
oDlg.setModel(oDlgModel) 'nastavit model dialogovému oknu
rem přidat dialogové okno k oknu dokumentu nebo Desktopu
oWindow=CreateUnoService("com.sun.star.awt.Toolkit") 'dialogové okno
if isMissing(oDoc) then 'přidat k Desktopu - pozor, systém může po chvíli vypsat že program neodpovídá
oDlg.createPeer(oWindow,null)
else 'přidat okno k oDoc
dim oToolkit as object
oToolkit=oDoc.currentController.frame.containerWindow
oDlg.createPeer(oWindow,oToolkit) 'spojení
end if
rem propočty na vystředění dialogového okna
with oSiz 'rozměr z kterého budu přepočítávat koeficient pro usazení dialogového okna průběhu doprostřed
.Width=iDlgWidth
.Height=iDlgHeight
end with
koef=iDlgWidth / oDlg.convertSizeToPixel(oSiz, com.sun.star.util.MeasureUnit.APPFONT).Width 'koeficient pro korekci dialogového okna
oSize=oDoc.CurrentController.Frame.ContainerWindow.GetPosSize 'rozměry okna Calcu
with oDlgModel
.positionX=fix( (koef*oSize.Width-iDlgWidth)/2 ) 'pozice X od levého horního rohu okna; šířku dialogu je třeba brát zvětšenou koef, pozici X pak zmenšenou koef
.positionY=fix( (koef*oSize.Height-iDlgHeight)/2 ) 'pozice Y od levého horního rohu okna
end with
oDlg.visible=true 'zobrazit dialog
progressBarInit=oDlg
exit function
chyba:
msgbox("Error " & Err & ": " & Error$ + chr(13) + "Line: " + Erl , 16 ,"progressBarInit")
End Function
Sub getDictionaries 'get the list of the dictionaries
dim oDics as object, s$, i%
oDics=createUnoService("com.sun.star.linguistic2.DictionaryList") 'list of the dictionaries
for i=lbound(oDics.Dictionaries) to ubound(oDics.Dictionaries)
s=s & oDics.Dictionaries(i).Name & chr(13)
next i
msgbox s
End Sub