Zpět na hlavní stránku: Makra a rozšíření pro OpenOffice
Autor: Tomáš Bílek –
Licence: LGPL, která je dostupná např. zde: http://www.opensource.org/licenses/lgpl-license.php nebo zde.
Tento program je svobodný software; můžete jej šířit a modifikovat podle ustanovení GNU LGPL.
Je rozšiřován v naději, že bude užitečný, avšak BEZ JAKÉKOLI ZÁRUKY.
Připomínky, poznámky a nalezené chyby můžete sdělit na .
Instalace: Makra uvedená jsou ve zdrojovém textu OOo Basicu. Instalují pouhým překopírováním do nějaké OOo Basic knihovny a modulu. Podrobnější pojenání o instalaci je zde.
Toto makro změní velikost všech písem v dokumentu writeru. Po spuštění se zeptá na koeficient zvětšení nebo zmenšení, po potvrzení se provedou změny.
Funguje v textu, v tabulkách a rámcích, změní i styly. Nefunguje v graficko-textových objektech
Používejte s rozmyslem, všechny provedené změny nemusí jít vrátit zpět pomocí funkce "Zpět" (Undo).
Sub ZmenVelikostPisemDokumentu ' pro writer, JTB v1.0 17.9.05
Dim oFamilies As Object, oStyle As Object, oStyles As Object
Dim Enum1, Enum2, oObj, TextElement, TextPortion As Object
dim n%,j%, k#, tmp$, direct&
dim cellnames, cell
tmp=inputbox("Zadejte koeficient zvětšení písma v dokumentu."+chr(13)+_
"Změny se provedou ve stylech i v ručně provedených změnách velikosti."+chr(13)+_
"Pozor, provedené změny možná nepůjde vrátit funkcí ZPĚT!","Změna výšky písem v celém dokumentu:","1.00")
if (tmp="") then
exit sub
end if
if 6 <> msgbox("Opravdu chcete zvětšit písma všech stylů "+cstr(val(tmp))+"x ?",4,"Potvrzení") then
exit sub
end if
k = val(tmp)
oFamilies = ThisComponent.StyleFamilies
oStyles = oFamilies.getByName("ParagraphStyles") ' odstavcove styly
for n = 0 to oStyles.count-1
oStyle=oStyles.getByIndex(n)
if oStyle.getPropertyState("CharHeight")=0 then 'zmenit pouze pozmenene velikosti
if oStyle.CharPropHeight=100 then ' mimo upravenych procentualne - ty zavisi na rodicich
oStyle.CharHeight = oStyle.CharHeight*k
end if
end if
next n
oStyle=oStyles.getByName("Standard")
if oStyle.getPropertyState("CharHeight")=1 then 'zmenit korenovy styl
oStyle.CharHeight = oStyle.CharHeight*k
end if
oStyles = oFamilies.getByName("CharacterStyles") ' znakove styly
for n = 0 to oStyles.count-1
oStyle=oStyles.getByIndex(n)
oStyle.CharHeight = oStyle.CharHeight*k
next n
' prepocet rucnich zmen
direct=0 'pocet rucnich zmen
Doc = thiscomponent 'StarDesktop.CurrentComponent
Enum1 = ThisComponent.Text.createEnumeration
' loop over all paragraphs
While Enum1.hasMoreElements
TextElement = Enum1.nextElement
If TextElement.supportsService("com.sun.star.text.Paragraph") Then
Enum2 = TextElement.createEnumeration
' loop over all paragraph portions
While Enum2.hasMoreElements
TextPortion = Enum2.nextElement
If TextPortion.getPropertyState("CharHeight") = _
com.sun.star.beans.PropertyState.DIRECT_VALUE Then
TextPortion.CharHeight = TextPortion.CharHeight * k
direct=direct+1
End If
Wend
End If
Wend
for n = 0 to ThisComponent.TextFrames.count-1 ' loop over all textframes
oObj=ThisComponent.TextFrames.getByIndex(n)
Enum1 = oObj.Text.createEnumeration
While Enum1.hasMoreElements ' loop over all paragraphs
TextElement = Enum1.nextElement
If TextElement.supportsService("com.sun.star.text.Paragraph") Then
Enum2 = TextElement.createEnumeration
While Enum2.hasMoreElements ' loop over all paragraph portions
TextPortion = Enum2.nextElement
If TextPortion.getPropertyState("CharHeight") = _
com.sun.star.beans.PropertyState.DIRECT_VALUE Then
TextPortion.CharHeight = TextPortion.CharHeight * k
direct=direct+1
End If
Wend
End If
Wend
next n
for n = 0 to ThisComponent.TextTables.count-1 ' loop over all tables
oObj=ThisComponent.TextTables.getByIndex(n)
CellNames=oObj.getCellNames()
For j = 0 to UBound(CellNames) ' loop over all cells
Cell = oObj.getCellByName(CellNames(J))
Enum1 = Cell.Text.createEnumeration
While Enum1.hasMoreElements ' loop over all paragraphs
TextElement = Enum1.nextElement
If TextElement.supportsService("com.sun.star.text.Paragraph") Then
Enum2 = TextElement.createEnumeration
While Enum2.hasMoreElements ' loop over all paragraph portions
TextPortion = Enum2.nextElement
If TextPortion.getPropertyState("CharHeight") = _
com.sun.star.beans.PropertyState.DIRECT_VALUE Then
TextPortion.CharHeight = TextPortion.CharHeight * k
direct=direct+1
End If
Wend
End If
Wend
Next j
next n
if direct>0 then
msgbox "Bylo nalezeno a změněno "+cstr(direct)+" ručně provedených změn velikosti písem."
end if
End Sub
Vytvořeno pro snadnější import textů a dat pro Writer a Calc v kódování Kamenických. Pracuje tak, že se do OOo nejprve načtou data pomocí Otevřít - Typ souboru: Kódovaný text. V dialogu ASCI II filtru který se objeví je třeba zvolit jako znakovou sadu Západní evropa DOS/OS2-850. Po načtení dat do dokumentu je třeba spustit toto makro, které převede celý dokument (u Calcu pouze současný list) na win1250. Funguje ve Writeru i Calcu
Sub Kamenicky_Dos850toWin1250 'v1.1 31/12/2006
dim oText, ReplaceDesc, i
dim kamenicky, win1250, dos850, vyzva as string
' prohlí·eče obvykle poškodí kódování, tedy přes dec kody:
dos850=chr(215)+chr(216)+chr(225)+chr(197)+chr(231)+chr(199)+chr(226)+chr(224)+chr(233)+chr(201)+chr(234)+chr(235)+chr(237)+chr(239)+chr(241)+chr(209)+chr(243)+chr(242)+chr(174)+chr(191)+chr(248)+chr(402)+chr(229)+chr(250)+chr(249)+chr(251)+chr(170)+chr(255)+chr(230)+chr(198)
win1250=chr(344)+chr(221)+chr(225)+chr(193)+chr(269)+chr(268)+chr(271)+chr(270)+chr(233)+chr(201)+chr(283)+chr(282)+chr(237)+chr(205)+chr(328)+chr(327)+chr(243)+chr(211)+chr(345)+chr(353)+chr(352)+chr(357)+chr(356)+chr(250)+chr(218)+chr(367)+chr(366)+chr(253)+chr(382)+chr(381)
pokyny ="Makro pro import textů v kódovaní kamenických do Writeru nebo Calcu. Postup: "+chr(13)+chr(13)+ _
" 1. Soubor > Otevřít, Typ souboru: 'Kódovaný text (*.txt)' pro Writer nebo 'Text CSV (*.csv, *.txt)' pro Calc. "+chr(13)+ _
" 2. V následujícím dialogu zvolit znakovou sadu DOS/OS2-850 "+chr(13)+ _
" 3. Po importu textu spustit toto makro a provést konverzi. Provede se v celém dokumentu nebo aktivním listu. "+chr(13)+chr(13)+ _
" Chcete provést nyní konverzi? "+chr(13)+" "
' pokud nasledujici radek zapoznamkujete, nebude uvodni dotaz
if 6 <> msgbox(pokyny, 4 + 256 + 32,"Konverze dokumentu / listu z DOS850 na Win1250:") then exit sub
If ThisComponent.SupportsService("com.sun.star.sheet.SpreadsheetDocument") Then
oText = ThisComponent.getCurrentController().getActiveSheet.createCursor
ElseIf ThisComponent.SupportsService("com.sun.star.text.TextDocument") Then
oText = ThisComponent
Else
msgbox "Nepodporovaný typ dokumentu"+Chr(13)+"Pracuji jen v ve Writeru a Calcu."
exit sub
end if
ReplaceDesc = oText.createReplacedescriptor
ReplaceDesc.SearchCaseSensitive = TRUE
ReplaceDesc.SearchRegularExpression = false
ThisComponent.CurrentController.statusIndicator.reset
ThisComponent.CurrentController.statusIndicator.start("Převod kódování z Dos850 na Win1250: ", len(win1250))
for i = 1 to len(win1250)
ReplaceDesc.SearchString = mid(dos850,i,1)
ReplaceDesc.ReplaceString = mid(win1250,i,1)
oText.ReplaceAll(ReplaceDesc)
ThisComponent.CurrentController.statusIndicator.setValue(i)
next i
ThisComponent.CurrentController.statusIndicator.end
ThisComponent.CurrentController.statusIndicator.reset
end sub