[Résolu][Calc] Dernière ligne et colonne avec des données

[Deedolith]

Bonjour,

Sur une feuille Calc, comme l'indique le titre, je cherche la dernière ligne et la dernière colonne avec des données (accessoirement, les premières aussi).
Les fonctions que j'ai écrit jusqu'à présent me donnent presque les résultats escomptés (sous forme de cellule), donc toute suggestion sera la bienvenue:

Code : Tout sélectionner

option explicit

const	searchTypeFormulas = 0
const	searchTypeValues = 1
const	searchTypeNotes = 2

public sub Main
	dim document as object
	set document   = ThisComponent
	
	dim sheet as object
	set sheet = document.sheets().getByIndex(0)
	
	dim firstCell as object
	set firstCell = getFirstCell(sheet)
	
	dim lastCell as object
	set lastcell = getlastcell(sheet)
end sub

private function getFirstCell(byref sheet as object) as object
	dim cell as object
	set cell = Sheet.getCellByPosition(sheet.columns.count-1, sheet.rows.count-1)
	
	dim sd as object
	set sd = cell.createSearchDescriptor()
	sd.SearchRegularExpression = True
	sd.SearchString = "."
	sd.SearchType = searchTypeValues
	sd.SearchBackwards = false
	
	set getFirstCell = sheet.findFirst(sd)
	
	set sd = nothing
	set cell = nothing
end function

private function getLastCell(byref sheet as object) as object
	dim cell as object
	set cell = Sheet.getCellByPosition(0, 0)
	
	dim sd as object
	set sd = cell.createSearchDescriptor()
	sd.SearchRegularExpression = True
	sd.SearchString = "."
	sd.SearchType = searchTypeValues
	sd.SearchBackwards = True
	
	set getLastCell = sheet.findFirst(sd)
	
	set rx = nothing
	set cell = nothing
end function

[micmac]

Bonjour et bienvenue sur le forum,

OpenOffice 2.4 sous Windows 10

Votre signature indique une version de OpenOffice qui n'est plus maintenue.
Est-ce une une erreur, un oubli, un choix, une obligation ?
Dans ce dernier cas, mentionnez-le dans votre signature par "Obligation de version".
Si c'est une version de LibreOffice que vous n'avez pas pu entrer, essayez de nouveau.

Il est fortement recommandé d'être à jour de la dernière version : Soyez à jour de la dernière version

Dans votre signature il est nécessaire d'indiquer :
1- La version exacte de AOO ou LibO (AOO 4.1.5, LibO 5.4.5 par exemple) ;
2- La version exacte du système d'exploitation (Windows XP SP3, Vista SP2, Windows 7 SP1, Win 8.1, Win 10, Ubuntu 17.04, MacOS 10.13.3, par exemple).
Accès direct à votre signature pour la corriger.

Cordialement.

[Dude]

Pas besoin d'aller chercher midi à 14h.
L'enregistreur de macro fait cela très bien avec l'instruction UNO GoToEndOfData.

[Churay]

Bonjour

L'enregistreur de macro fait cela très bien avec l'instruction UNO GoToEndOfData.

L'option proposé par Dude:

Code : Tout sélectionner

Sub LastCell
dim oDoc AS Object, oDisp AS Object
Dim nRow AS Long, nCol AS Long
	oDoc = thisComponent.CurrentController.Frame
	oDisp = createUnoService("com.sun.star.frame.DispatchHelper")
	oDisp.executeDispatch(oDoc, ".uno:GoToEndOfData", "", 0, Array())
	
	nRow = thisComponent.CurrentSelection.CellAddress.Row
	nCol = thisComponent.CurrentSelection.CellAddress.Column
	
	MsgBox "Dernière Ligne : " & nRow & chr(10) & "Dernière Colonne : " & nCol
End Sub

Une autre option via l'API :

Code : Tout sélectionner

Sub LastCell_API
dim oSheet AS Object, oCursor AS Object
Dim nRow AS Long, nCol AS Long
	oSheet = thisComponent.CurrentController.ActiveSheet
	oCursor = oSheet.createCursor : oCursor.gotoEndOfUsedArea(False)
	
	WITH oCursor.RangeAddress
		nRow = .EndRow : nCol = .EndColumn
	END WITH
	
	MsgBox "Dernière Ligne : " & nRow & chr(10) & "Dernière Colonne : " & nCol
End Sub

[Deedolith]

Merci,
je jetterai un coup d'œil sur le dispatcher.

@Dude:
Par expérience, je ne fais pas confiance à l'enregistreur de macro, car il fait une utilisation abusive des objets "courants", susceptible de changer d'état à la moindre action utilisateur.

@Churay:
gotoEndOfUsedArea() ne correspond pas à mon besoin, car cela prend on considération les cellules formatées avec une mise en forme, qui n'appartiennent pas spécialement à la plage de données.

[Hubert Lambert]

Bonjour,

Un autre exemple, rapide :

Code : Tout sélectionner

    doc = thiscomponent
    f1 = doc.Sheets(0)
    usedcells = f1.queryContentCells(31)
    lastcol = 0
    lastrow = 0
    addresses = usedcells.RangeAddresses
    for each address in addresses
        if address.EndColumn > lastcol then lastcol = address.EndColumn
        if address.EndRow > lastrow then lastrow = address.EndRow
    next address
    lastcol = f1.Columns(lastcol).Name
    lastrow = lastrow +1
    msgbox "Dernière colonne : " & lastcol & chr(10) & "Dernière ligne : " & lastrow

Plus d'infos : https://www.openoffice.org/api/docs/com ... ntentCells.

Cordialement.

[Deedolith]

Merci Hubert, ton code semble faire ce que je veux (avec quelques modifs).

Les autres solutions n'ont malheureusement pas produit le résultat escompté.

Pour ceux que ca intéresse, voici le code final:

Code : Tout sélectionner

option explicit

const cellFlagVALUE as integer = 1
const cellFlagDATETIME as integer = 2
const cellFlagSTRING as integer = 4
const cellFlagANNOTATION as integer = 8
const cellFlagFORMULA as integer = 16

public sub Main
	dim document as object
	set document   = ThisComponent
	
	dim sheet as object
	set sheet = document.sheets().getByIndex(0)
	
	dim firstCell as object
	set firstCell = getFirstCell(sheet)
	
	dim lastCell as object
	set lastcell = getlastcell(sheet)
end sub

private function getFirstCell(byref sheet as object) as object
	dim usedCells As Object
	set usedcells = sheet.queryContentCells(cellFlagVALUE or cellFlagDATETIME or cellFlagSTRING or cellFlagANNOTATION or cellFlagFORMULA)
	
	dim addresses as Object
	set addresses = usedCells.rangeaddresses
	
	dim firstColumn  as long
	firstColumn = sheet.columns.count
	
	dim firstRow as long
	firstRow = sheet.rows.count
	
	dim address as object
	for each address in addresses
    	if address.startColumn < firstColumn then firstColumn = address.startColumn
        if address.startRow < firstRow then firstRow = address.startRow
    next
    
    set addresses = Nothing
    set usedCells = nothing
    set getFirstCell = sheet.getCellByPosition(firstColumn, firstRow)
end function

private function getLastCell(byref sheet as object) as object
	dim usedCells As Object
	set usedcells = sheet.queryContentCells(cellFlagVALUE or cellFlagDATETIME or cellFlagSTRING or cellFlagANNOTATION or cellFlagFORMULA)
	
	dim addresses as Object
	set addresses = usedCells.rangeaddresses
	
	dim lastColumn  as long
	lastColumn = -1
	
	dim lastRow as long
	lastRow = -1
	
	dim address as object
	for each address in addresses
    	if address.endColumn > lastColumn then lastColumn = address.endColumn
        if address.endRow > lastRow then lastRow = address.endRow
    next
    
    set addresses = Nothing
    set usedCells = nothing
    set getLastCell = sheet.getCellByPosition(lastColumn, lastRow)
end function

J'ai utilisé des constantes en lieux et place des "valeurs magiques".

[Hubert Lambert]

Les constantes sont déjà disponibles, tu n'es pas obligé de les redéfinir :

Code : Tout sélectionner

cellflags = com.sun.star.sheet.CellFlags
[...]
usedcells = sheet.queryContentCells(cellflags.VALUE or cellflags.DATETIME or cellflags.STRING or cellflags.ANNOTATION or cellflags.FORMULA

[Deedolith]

Les constantes sont déjà disponibles, tu n'es pas obligé de les redéfinir :

Je ne l'ai pas indiqué (je n'avais pas de raison de le faire), mon but est d'automatiser OOO depuis les produits Microsoft (VBA).
Comme l'API n'expose que les interfaces, il me faut les constantes.

PS: comment indiquer que le sujet est résolu ?

[toucan]

Bonjour

PS: comment indiquer que le sujet est résolu ?

Voir A propos des balises - Comment mettre [Résolu] ou [Issue]
Cordialement