Tomáš Bílek nám zaslal makro na proporcionální změnu velikosti písem ve Writeru.
'**************************************************************
' Makro na proporcionální změnu velikosti písem ve Writeru.
' Změny by se měly projevit ve všech textových stylech, hlavním textu,
' textových rámcích a tabulkách.
' Nepracuje v grafických objektech ve kterých je i text.
Sub ZmenVelikostPisemDokumentu ' pro writer, JTB v1.0 17.9.05
Dim oFamilies, oStyle, oStyles As Object
Dim Enum1, Enum2, oObj, TextElement, TextPortion As Object
dim n%,j%, k#, tmp$, direct as long
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
'************************************************************************
