Je potřeba otestovat existenci listu FAKTURA, to je na začátku a také se tam hned provede přesunutí listu na první pozici.
Sub NOVE_mazani 'pomocí com.sun.star.Sheet.SheetCellRanges + UNO pro skrýt označené řádky
on local error goto chyba
dim oDoc as object, oSheet as object, oRange as object, oRanges as object, oRangeAddress as new com.sun.star.table.CellRangeAddress, oEnum as object, o as object, data(), i&, iSloupec&, i1&, i2&, iSheet%, aSkryt as variant, sList$, oSheets as object
dim oDlg as object, oPrubeh as object, oButton as object, iPrubeh&, bCancel as boolean 'pro ukazatel průběhu
const iStep=30 : iPrubeh=0 'pro ukazatel průběhu
oDoc=ThisComponent
rem test existence požadovaného listu
sList="FAKTURA" 'jméno listu
oSheets=oDoc.Sheets 'listy sešitu
if oSheets.hasByName(sList) then 'sešit list obsahuje
oSheet=oSheets.getByName(sList) 'požadovaný list
oSheets.moveByName(sList, 0) 'přesune list na první pozici (tenhle řádek se klidně může dát až na konec, tedy za dispatcher.executeDispatch)
iSheet=oSheet.RangeAddress.Sheet 'číslo požadovaného listu
else
msgbox(sList, 48, "List neexistuje")
exit sub
end if
iSloupec=3 'sloupec dle kterého budu skrývat (A=0, B=1 atd.)
i1=1 : i2=3100 'testované řádky (první řádek=0, druhý=1 atd.)
aSkryt=0 'hodnota pro kterou skrývám řádek (v případě řetězců třeba "0")
oRanges=oDoc.createInstance("com.sun.star.sheet.SheetCellRanges") 'rozsahy vybraných buněk
with oRangeAddress 'sloupce přidávaného rozsahu
.Sheet=iSheet
.StartColumn=iSloupec
.EndColumn=iSloupec
end with
rem ukazatel průběhu
oDlg=progressBarInit(0, i2-i1, oDoc)
oDlg.title="Mažu nulové :-)"
oPrubeh=oDlg.getControl("Pprogress")
oButton=oDlg.getControl("Pbutton")
oRange=oSheet.getCellRangeByPosition(iSloupec, i1, iSloupec, i2) 'data ze sloupce dle kterého skrývám řádky
data=oRange.getDataArray
dim iZac&, iKon&, a as variant, b as boolean
iZac=i1 : iKon=0 : b=false
rem hlavní smyčka
for i=lbound(data) to ubound(data)
rem ukazatel průběhu
iPrubeh=iPrubeh+1
if iPrubeh=iStep then 'vykreslovat až po nějakém počtu kroků
oPrubeh.value=i
iPrubeh=0 'reset aktuálního počtu kroků
end if
if oButton.Model.state=1 then 'stisknuto Cancel v ukazateli průběhu
bCancel=true
exit for
end if
rem porovnávání hodnot a přidávání do oRanges
a=data(i)(0) 'aktuální hodnota ze sloupce -- v ukázce jde o číslo; v případě řetězců třeba a=CStr(data(i)(0))
if a=aSkryt then 'hodnota je skrývaná
if iKon=0 then iZac=i+i1 'nemám žádný počet řádků tedy jde o první řádek rozsahu tak pamatuji číslo řádku
iKon=iKon+1 'zvětšuji počet řádků které budu přidávat do rozsahu
b=true 'až narazí na neskrývaný řádek tak přidá rozsah
elseif b=true then 'řádek nemá hodnotu při které se skrývá
with oRangeAddress 'řádky přidávaného rozsahu
.StartRow=iZac
.EndRow=iZac+iKon-1
end with
oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah
iKon=0
b=false
else 'šlo o neskrývaný řádek takže začátek přidávaného rozsahu bude minimálně na dalším řádku
iZac=iZac+1
end if
next i
rem pro ukazatel průběhu
if bCancel=true then 'stisknuto Cancel v ukazateli průběhu
msgbox("Přerušeno")
goto konec
end if
if iKon>0 then 'poslední řádky ještě mají být skryty
with oRangeAddress 'řádky přidávaného rozsahu
.StartRow=iZac
.EndRow=iZac+iKon-1
end with
oRanges.AddRangeAddress(oRangeAddress,true) 'přidat rozsah
end if
rem skrýt rozsahy přes UNO - rychlé - ale funguje jen v aktuálním listě
dim document as object, dispatcher as object
oDoc.CurrentController.ActiveSheet=oSheet 'požadovaný list jako aktivní aby v něm správně provedl uno příkaz
oDoc.CurrentController.Select(oRanges) 'označit rozsahy
document=oDoc.CurrentController.Frame
dispatcher=createUnoService("com.sun.star.frame.DispatchHelper")
dispatcher.executeDispatch(document, ".uno:DeleteRows", "", 0, array()) 'UNO pro smazání označených řádků
konec:
oDlg.dispose() 'deaktivovat ukazatel průběhu
exit sub
chyba:
msgbox("Řádek: " & Erl & chr(13) & "Chyba č. " & Err & chr(13) & Error, 16, "NOVE_mazani")
End Sub
