„Láska vdaných žen je nejcennější na světě, manželé o tom ovšem nevědí.“ Oscar Wilde

Zpět na hlavní stránku: Makra a rozšíření pro OpenOffice


Drobná makra pro Open Office ve zdrojovém tvaru

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.

Obsah:

  1. Proporcionální změna velikosti všech písem v celém dokumentu
  2. Převod z kódování kamenických na win1250 po importu do OOo




Proporcionální změna velikosti všech písem v celém dokumentu

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



Zpět nahoru do obsahu



Převod z kódování kamenických na win1250 po importu do OOo

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



Zpět nahoru do obsahu