Fórum pro uživatele kancelářského balíku OpenOffice | LibreOffice
 

#1 13. 5. 2025 21:19:16

Petr82
Člen
Registrace: 15. 1. 2021
Příspěvků: 7

Re: Makro na Seskupit... (F12)

Omlouvám se, web mi házel nějakou chybu a zdálo se, že příspěvek nevložil, tedy jsem ho vložil omylem několikrát. Můžete-li někdo, prosím, smažte ty navíc.
Děkuji, Petr


Původní dotazy: napsal(a)

Našel by se, prosím, někdo, kdo by byl ochoten mi i za peníze vytvořit pro LibreOffice Calc makro (nebo nějak jinak), které by umělo na aktivním listu provést funkci Seskupit (F12) pro určité skupiny řádků?

Sem nejdou vkládat přílohy, abych sem dal tu tabulku, tedy se to pokusím popsat.

Mám tabulku, kde jsou různě seskupení řádků, které mají ve sloupci (D) text "VV". Tyto bloky řádků potřebuji na celém listu Seskupit. Tedy příklad tabulky:
řádek 9 = prázdný
řádek 10 = různě text a čísla různé sloupce (ve sloupci (D) je text, ale jiný jak na řádku 11)
řádek 11 = sloupec (D) text "VV"
řádek 12 = sloupec (D) text "VV"
řádek 13 = sloupec (D) text "VV"
řádek 14 = různě text a čísla různé sloupce
řádek 15 = různě text a čísla různé sloupce
řádek 16 = sloupec (D) text "VV"
řádek 17 = sloupec (D) text "VV"
řádek 18 = různě text a čísla různé sloupce
řádek 19 = sloupec (D) text "VV"
řádek 20 = různě text a čísla různé sloupce

Potřebuji makrem docílit, aby Seskupilo řádky 11-13 a 16-17 a 19.

Makra umím jen naprosté základy a toto je už nad moje síly.

Děkuji za pomoc, Petr

Editoval Petr82 (17. 5. 2025 20:24:51)

Offline

#2 13. 5. 2025 21:31:09

Petr82
Člen
Registrace: 15. 1. 2021
Příspěvků: 7

Re: Makro na Seskupit... (F12)

Toto vlákno ponechat, tento dotaz platí. Děkuji

Offline

#3 14. 5. 2025 05:06:07

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 3,474

Re: Makro na Seskupit... (F12)

To by neměl být velký problém, ale chce to ukázku dat. Pošlete mi vzorek na email níže. Peníze nechci.


Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#4 14. 5. 2025 13:13:58

Petr82
Člen
Registrace: 15. 1. 2021
Příspěvků: 7

Re: Makro na Seskupit... (F12)

Poslal jsem tabulku e-mailem, děkuji moc!

Offline

#5 14. 5. 2025 15:42:25

neutr
Člen
Registrace: 8. 3. 2007
Příspěvků: 3,474

Re: Makro na Seskupit... (F12)

Základní řešení pro seskupit jednu skupinu:

Sub DejMatici
Dim oCell As Object 
oCell = ThisComponent.CurrentController.getSelection() 
With oCell.RangeAddress 
SH = .Sheet 
SC = .StartColumn 
SR = .StartRow
ER = .EndRow
End With 
SeskupitRows(SH, SC, SR, ER) 
End Sub

Sub SeskupitRows(ByVal SH as integer,ByVal SC as long, ByVal SR as long, ByVal ER as long)
	Dim oDoc as Object
	Dim oSheet as Object
	Dim oCellAdr as Object
		oDoc = ThisComponent
		oSheet = ThisComponent.currentcontroller.activesheet
		oCellAdr = createUnoStruct("com.sun.star.table.CellRangeAddress")
		with oCellAdr
			.Sheet = SH
			.StartColumn = SC
  			.StartRow = SR			
  			.EndRow = ER			
		end with
		oSheet.group( oCellAdr, com.sun.star.table.TableOrientation.ROWS )
		msgbox("Seskupeno",0,"Hotovo")
End Sub

Šlo by to postavit na celý výčet, ale nevím například zda poslední případ - položka 47 se má udělat do jednoho seskupení nabo do dvou (řádky 32 až 41).
     Mělo by to fungovat na každém aktivním souboru, sešitu i listu tak, že vyberete úsek a spustíte makro. Jde o řádky takže je jedno ve kterém sloupci uděláte výběr.


     Pokud to takto postačuje můžete makro zadat do šablony a otevírat přímo šablonu už s funkčními makry, nebo si to nakopírujte do "Moje makra LO" a vždy to raději nakopírujte přímo do sešitu i když se to dá deklarovat pro všechny sešity jako "Global" a podobně.


Moje e-mailová adresa
Pokud je Váš problém vyřešen, označte prosím svůj příspěvek za "VYŘEŠENÝ"
Zlepšíte orientaci při vyhledávání řešení JAK OZNAČIT TÉMA ZA VYŘEŠENÉ

Offline

#6 17. 5. 2025 20:18:49

Petr82
Člen
Registrace: 15. 1. 2021
Příspěvků: 7

Re: Makro na Seskupit... (F12)

To výše bohužel nedělá co potřebuji, je to jen MAKRO na to co dělá klávesa F12, ale buňky pro sloučení se stále musí vybírat ručně. Já potřebuji, aby to makro samo našlo na stránce řádky s textem "VV" ve sloupci D a ty co spolu sousedí sloučilo.
Už jsem ale našel odpověď jinde, tedy vyřešeno.
Děkuji za pomoc

Offline

#7 17. 5. 2025 20:20:58

Petr82
Člen
Registrace: 15. 1. 2021
Příspěvků: 7

Re: Makro na Seskupit... (F12)

Takto by to MAKRO mělo vypadat, když by to potřeboval i někdo jiný.
Mnohokráte děkuji autorovi!

MAKRO napsal(a)

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

Editoval Petr82 (17. 5. 2025 20:22:53)

Offline

Zápatí