hlavicka.png, 18 kB

Calc - Makra

WriteLog

28.9.2006

Toto makro používám ve dvou případech. Při vývoji mi slouží jako jeden z ladicích nástrojů a když je aplikace hotová tak slouží k logování činnosti aplikace. Dá se říct že to je první makro, které vkládám do složitějších aplikací. Dlužno říct, že makro je přepisem z VBA kdy jsem ho hojně využíval pro excelovské aplikace. Podobné makro mám i pro VBS.

' obsluhuje logovaci soubor
SUB WriteLog(Zapis as string)
const PocetDnuLogu = 31
dim LogSoubor as string, TmpSouborb as string, Zaznam as string
dim LogFreeFile as integer, TmpFreeFile as integer
dim MinDatum as date, Zapisovat as bool
 on error resume next
' nastav pracovni cesty
  Zaznam = ConvertFromURL(ThisComponent.Url)
  Zaznam = left(Zaznam, len(Zaznam)-3)
  LogSoubor = Zaznam & "log"
  TmpSoubor = Zaznam & "tmp"
  
  LogFreeFile = FreeFile
  select case Zapis
  case "START" ' ke startu pridej datum a cas
    Zapis = Zapis & " - " & Format(Now, "dd.mm.yyyy hh:mm:ss")
  ' pri uvodnim logu odstran stare zaznamy
    MinDatum = Now - PocetDnuLogu
    open LogSoubor for input as LogFreeFile
    if not Err then
      TmpFreeFile = FreeFile
      open TmpSoubor for output as TmpFreeFile
      do until EOF(LogFreeFile)
        Line input #LogFreeFile, Zaznam
        if Zapisovat then
           print #TmpFreeFile, Zaznam
        else
          if Left$(Zaznam, 5) = "START" then
            Zapisovat = DateValue(Right$(Zaznam, 19)) >= MinDatum
            if Zapisovat then print #TmpFreeFile, Zaznam
          end if
        end if
      loop
    ' Uzavři oba soubory, dočasný soubor bude log souborem
      close #LogFreeFile: close #TmpFreeFile
      FileCopy TmpSoubor, LogSoubor
      Kill TmpSoubor
    end if
  case "KONEC" ' na zaver pridej datum a odradkovani
    Zapis = Zapis & " - " & Format(Now, "dd.mm.yyyy hh:mm:ss") _
          & chr(13) & chr(10)
  case "VYMAZ" ' na vyslovne prani smaz logovaci soubor
    open LogSoubor for output as LogFreeFile
    close #LogFreeFile
    exit sub
  case else ' pracovni zaznam odsad o dve mezery
    Zapis = " " & Zapis
  end select
' zapis zaznam do log souboru
  open LogSoubor for append as LogFreeFile
  print #LogFreeFile, Zapis
  close #LogFreeFile
END SUB

Procedura WriteLog se volá s textovým parametrem Zapis. V předávaném parametru může být libovolný text, který chcete zapsat do logovacího souboru.
Existují ovšem tří klíčová slova, která když se objeví na začátku předávaného textu, mají nějaký význam. Klíčová slova musí být zapsána velkýmí písmeny.

START
Za text se slovem START se automatický přidá datum a čas. Po nalezení tohoto klíčového slova se provádí odstranění starých záznamů viz. dále.
KONEC
Za text se slovem KONEC se automatický přidá datum a čas, a poté odřádkování
VYMAZ
Pokud je nalezeno slovo VYMAZ na začátku textu, bude logovací soubor vymazán.
ostatní text bude odsazen o dvě mezery a zapsán beze změny

Po nalezení klíčového slova START dochází k odstranění starých záznamů. Staré záznamy jsou ty které jsou starší než je nastaveno v konstantě: PocetDnuLogu. Já tam mám 31, čili jeden měsíc.

Při ladění programu, vložím na jeho začátek příkaz WriteLog "VYMAZ", a pak kdekoli to uznám za vhodné použiji Writelog s libovolným textem. Výhoda je v tom, že jsem ušetřen neustáleho přepisování příkazu msgbox a přerušování programu. Nechám proběhnout program, a pak si přečtu logovací soubor.

Pokud se jedná o větší aplikaci, případně pravidelně spouštěnou aplikaci, Zapíší do startovací části aplikace WriteLog "START", do ukončovací části aplikace WriteLog "KONEC" a kamkoli do kódu
WriteLog sLog, kde sLog je proměnná pro logovací záznam.

Proceduru WriteLog ukládám do modulu sešitu, který chci logovat. Pak se logovací soubor bude jmenovat stejně jako sešit, ale s příponou .log. Logovací soubor se bude ukládat do adresáře ve kterém je uložen daný sešit.

Myslím si, že to je celkem jednoduchá ukázka, jak se dá pracovat s textovými soubory ve StarBasicu. Je to úplně stejné jako v QuickBasicu nebo VB. Nápověda pro práci s textovými soubory je:
Nápověda/OpenOffice.org Basic/Funkce typu runtime/Funkce pro práci se soubory
Je zajímavé, že ačkoliv SB evidentně příkaz Print # zná, tak v nápovědě není uveden. Najdeme tam pouze zmínky v příkladech u jiných souborových příkazu. Je to asi zapřičiněno, tím že SB zná příkaz Print pro výpis na obrazovku a překladatelům nápovědy asi uniklo, že to jsou dva různé příkazy. Asi se na to zkusím někde zeptat, zatím nevím kde.

I když vím, že se v Linuxu nepoužívá pro konec řádku chr(13) & chr(10), ale jen chr(13), tak jsem to vyzkoušel i v Linuxu a ono to funguje. Vyzkoušeno na:
GNU/Linux - Kubuntu 6.06, OOo 2.0.2
Windows XP Home SP2, OOo 2.0.3

ClearUnlockedCells

23.9.2006

Toto makro bylo vytvořeno pro diskuzi na www.openoffice.cz. Byl tam dotaz na možnost mazání pouze nezamčených buněk v danném rozsahu. Makro jednoduše projde každou buňku, zde v rozsahu A1:C10 a maže pouze nezamčené buňky.

sub ClearUnlockedCells
dim oSheet as object, oCell as object
dim lSloupec as long, lRadek as long, lCellFlags as long
' Nastavit co chci mazat
  with com.sun.star.sheet.CellFlags
    lCellFlags = .VALUE + .STRING + .DATETIME + .FORMULA
  end with
' dalsi mozne konstanty:
'.FORMATTED, .ANNOTATION, .STYLES, .HARDATTR, .EDITATTR, .OBJECTS
  set oSheet = ThisComponent.Sheets("Skills")
' nastavit adresu
  with oSheet.getCellRangeByName("A1:C10").RangeAddress
  ' projdi vsechny bunky a nezamknute smaz
    for lSloupec = .StartColumn to .EndColumn
      for lRadek = .StartRow to .EndRow
        set oCell = oSheet.getCellByPosition(lSloupec, lRadek)
        iif(oCell.CellProtection.IsLocked,, _
                   oCell.ClearContents(lCellFlags))
      next
    next
  end with
end sub


SelectionVisiblePaste

23.9.2006

Toto makro bylo vytvořeno pro diskuzi na www.openoffice.cz. Byl tam dotaz na možnost vkládání dat do vyfiltrovaných, pouze do viditelných buněk. Následujicí makro projde všechny buňky výběru, i nesouvislých výběru a vloží do nich hodnotu ze schránky.

Sub SelectionVisiblePaste
' Procedura SelectionVisiblePaste vlozi data ze schranky
' pouze do viditelnych vybranych bunek.
' ve schrance musi byt data, ktera lze umistit do jedne bunky
' To se hodi ve dvou pripadech
' 1) pri vkladani hodnoty do vyfiltrovanych oblasti
' 2) pri vkladani hodnoty do nesouvislych oblasti.
dim oControl as object, oList as object, oBunka as object
dim oRozsahy as object, oRozsah as object
dim oDoc as object, oDisp as object
dim Oblast as long, Sloupec as long, Radek as long
dim PrvniBunka as bool
' nastaveni objektu
  set oControl = ThisComponent.CurrentController
  set oDoc = oControl.Frame
  set oDisp=createUnoService("com.sun.star.frame.DispatchHelper")
  set oList = oControl.ActiveSheet
  set oRozsahy = oControl.getSelection()
  PrvniBunka = true
  on error goto CHYBA ' oznameni pripadne chyby
  ThisComponent.LockControllers ' Zakaz zobrazovani
' pokud je vice oblasti, prochazej je postupne
  if oRozsahy.getImplementationName="ScCellRangesObj" then
    for Oblast = 0 to oRozsahy.Count-1
      set oRozsah = oRozsahy(Oblast)
      gosub PROJDI
    next
  else
    set oRozsah = oRozsahy
    gosub PROJDI
  end if
goto KONEC
PROJDI:
' projde vsechny bunky rozsahu a vlozi do viditelnych
' obsah schranky
with oRozsah.RangeAddress
  for Sloupec = .StartColumn to .EndColumn
    if oList.Columns(Sloupec).isVisible then
      for Radek = .StartRow to .EndRow
        if oList.Rows(Radek).isVisible then
          if PrvniBunka then'do prvni bunky vloz obsah schranky
            set oBunka = olist.getCellByPosition(Sloupec, Radek)
                                oControl.select(oBunka)
          ' napred vymaz jeji obsah
            with com.sun.star.sheet.CellFlags
              oBunka.clearContents(.VALUE + .STRING + DATETIME _
                                          + .FORMULA)
            end with
          ' pote do ni vloz obsah schranky
            dim a(5) as new com.sun.star.beans.PropertyValue
            a(0).Name = "Flags":          a(0).Value = "SVDF"
            a(1).Name = "FormulaCommand": a(1).Value = 0
            a(2).Name = "SkipEmptyCells": a(2).Value = false
            a(3).Name = "Transpose":      a(3).Value = false
            a(4).Name = "AsLink":         a(4).Value = false
            a(5).Name = "MoveMode":       a(5).Value = 4
            oDisp.executeDispatch(oDoc, ".uno:InsertContents", _
                                    "", true, a())
            PrvniBunka = false
          else ' zbyle bunky kopiruj z prvni bunky
            olist.getCellByPosition(Sloupec, Radek).formula _
                                            = oBunka.formula
          end if
        end if
      next
    end If
  next
end with
return
CHYBA:
  msgbox "Někde se stala chybička"
KONEC:
  ThisComponent.UnlockControllers 'Povol zobrazovani
  oControl.select(oRozsahy) ' nakonec vyber puvodni select
  on error resume next
end sub

Makro jsem umístil do modulu v knihovně Moje makra/Standard, tak že je přístupné pro všechny sešity. Na panel vedle ikony "vložit" jsem si umistil ikonu, která toto makro spouští.

Použití:
1) ve filtru
- nastavím filtr
- zapiší hodnotu do první buňky
- zkopíruji ji do schránky
- vyberu zbyle buňky
- spustím makro

Po zrušení filtru budou hodnoty zapsány pouze v buňkách, které byly viditelně vybrány.

2) vkládání hodnoty do nesouvislé oblasti
pokud potřebujete vložit hodnotu do více nesouvislých oblasti,
calc vám to normálně neumožní. Postup pomocí makra je obdobný.
- zapiší hodnotu do nějaké buňky
- zkopíruji ji do schránky
- vyberu nesouvislé oblasti
- spustím makro

I zde platí, že pokud budou součásti výběru, skryté sloupce, nebo řádky, nebude hodnota do těchto buněk zapsána. Makro přepisuje hodnoty ve vybraných oblastech bez varování na rozdíl při normálním kopírování v calcu. Není to nijak rychlé, ale možná to někomu pomůže.




Další >>

vgraf2@cbox.cz

23.09.2006

stránky

hlavní stránka

Calc


odkazy

Zahraniční