OpenOffice.cz - web věnovaný kancelářským balíkům OpenOffice.org

Sub Seskupit_VV_KROS_aktivni_list 'seskupí řádky aktivního listu dle hodnoty ve sloupci D
    const sRetezec="VV" 'řetězec podle kterého se má seskupovat
    const iSloupec=3 'číslo prohledávaného sloupce (A=0, B=1, C=2, D=3 ...)
    const sZpet="Seskupit makrem" 'hláška pro krok Zpět
   
    dim oDoc as object, oSheet as object, oColumn as object, oCur as object, i&, j&, oRanges as object, oRange as object, data(), b as boolean, o as object, oCells as object, _
        undoMgr as object, bSeskupeno as boolean
    oDoc=ThisComponent
    undoMgr=oDoc.undoManager 'manažer kroků Zpět
    oSheet=oDoc.CurrentController.ActiveSheet 'aktuální list
    oCur=oSheet.createCursor 'listový kurzor
    oCur.gotoStartOfUsedArea(false) 'kurzor na začátek použité oblasti listu
    i=oCur.RangeAddress.StartRow 'první použitý řáděk
    oCur.gotoEndOfUsedArea(false) 'kurzor na konec použité oblasti listu
    j=oCur.RangeAddress.EndRow 'poslední použitý řádek listu
    oColumn=oSheet.getCellRangeByPosition(iSloupec, i, iSloupec, j) 'použitý sloupec D
    oRanges=oColumn.CellFormatRanges 'rozsahy buněk s různým formátem ve sloupci D
    for each oRange in oRanges 'procházet jednotlivé rozsahy
        data=oRange.getDataArray() 'obsah buněk v rozsahu
        b=true
        for each o in data 'obsah bunky v rozsahu
            if o(0)<>sRetezec then 'v buňce není seskupovaný řetězec
                b=false
                exit for
            end if
        next
        if b then 'v rozsahu buněk jsou jen požadované řetězce
            if NOT bSeskupeno then 'ještě nebylo nic seskupeno tak zapnout manažer Zpět
                undoMgr.enterUndoContext(sZpet) 'hláška pro Zpět
                bSeskupeno=true
            end if
            oSheet.ungroup(oRange.RangeAddress, 1) 'zrušit seskupení když tam je (aby nebylo podruhé)
            oSheet.group(oRange.RangeAddress, 1) '1 = seskupit řádky rozsahu
        end if
    next
    if bSeskupeno then undoMgr.leaveUndoContext 'bylo něco seskupeno tak ukončit manažer Zpět
End Sub