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 '************************************************************************