Calc - Makra
WriteLog
28.9.2006Toto 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.
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.2006Toto 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 subSelectionVisiblePaste
23.9.2006Toto 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ší >>
stránky
Calc
odkazy
Zahraniční