Forum OpenOffice LibreOffice NeoOffice

Forum francophone de support pour Apache OpenOffice, LibreOffice et dérivés de OpenOffice.org
https://forum.openoffice.org/fr/forum/

[Résolu] [Calc] Filtre sans les formules

https://forum.openoffice.org/fr/forum/viewtopic.php?t=60512

Page 1 sur 1

[Résolu] [Calc] Filtre sans les formules

Publié : 20 mai 2019 11:48
par tomasi
Bonjour,

Ma macro pour effectuer un tri en fonction de la valeur d'une cellule fonctionne parfaitement sauf que j'aimerais que celle ci ne transpose pas les formules mais uniquement les valeurs.
Pourriez-vous m'aider s'il vous plaît ?
Voici la macro que dois je ajouter comme ligne pour arriver à mes fins.

Code : Tout sélectionner

Option Explicit
Sub Tri1


Dim oDoc as Object, fBase as Object, fSel1 as Object, fSel2 as Object
Dim maZone as Object, oFilterDesc as Object, maCellule as Object
Dim oFields(0) As New com.sun.star.sheet.TableFilterField
Dim CellVides as Variant, y as Long

	oDoc = thisComponent
	fBase = oDoc.Sheets.getByName("Tri O_U Today")
	fSel1 = oDoc.Sheets.getByName("Selection Over Today")
	fSel2 = oDoc.Sheets.getByName("Selection Under Today")
	maZone = fBase.getCellRangeByName("A1:A1000")
	CellVides = maZone.queryEmptyCells.RangeAddresses
	y = CellVides(UBound(CellVides)).StartRow
	maZone = fBase.getCellRangeByName("A1:Ak" & y)
	oFilterDesc = maZone.createFilterDescriptor(True)
	With oFields(0)
		.Field = 36
		.IsNumeric = True
		.NumericValue = 1.8
		.Operator = com.sun.star.sheet.FilterOperator.GREATER_EQUAL
		
	End With
	With oFilterDesc
		.CopyOutputData = True
		.ContainsHeader = False
		.Orientation = com.sun.star.table.TableOrientation.COLUMNS
		maCellule = fSel1.getCellRangeByName("A1")
		.OutputPosition = maCellule.CellAddress
		.FilterFields = oFields()
	End With
	maZone.filter(oFilterDesc)
	oFilterDesc = maZone.createFilterDescriptor(True)
	With oFields(0)
		.Field = 36
		.IsNumeric = True
		.NumericValue = 0.2
		.Operator = com.sun.star.sheet.FilterOperator.LESS
	End With
	With oFilterDesc
		.CopyOutputData = True
		.ContainsHeader = False
		.Orientation = com.sun.star.table.TableOrientation.COLUMNS
		maCellule = fSel2.getCellRangeByName("A1")
		.OutputPosition = maCellule.CellAddress
		.FilterFields = oFields()
	End With
	maZone.filter(oFilterDesc)
End Sub

Re: [Calc] Filtre sans les formules

Publié : 20 mai 2019 12:39
par Bidouille
Pour être aidé efficacement par les bénévoles et surtout leur faire gagner du temps, veuillez fournir les éléments suivants :
  1. insérer dans le corps du message le code de la macro exposant le problème
  2. joindre un document explicatif intégrant cette macro avec les données de départ (feuille1) et le résultat à obtenir (feuille2)
  3. fournir un mode pas-à-pas permettant de reproduire ce qui a été fait ou ce que vous cherchez à faire pour arriver au problème
  4. ajouter des copies écran (situation avant / après) si cela permet de mieux comprendre
Merci de publier ces informations à la suite.

Re: [Calc] Filtre sans les formules

Publié : 20 mai 2019 13:14
par tomasi
Bonjour,

Je voudrais juste savoir si il est possible de rajouter une ligne dans la macro qui permettrait que les lignes filtrées qui arrivent sur la feuille de destination ne prennent pas en compte les formules de la feuille de départ mais juste les valeurs.
Merci d'avance pour votre aide

Re: [Calc] Filtre sans les formules

Publié : 20 mai 2019 15:06
par OOotremer971
Bonjour,
En espérant que tu utilise xray :)
Il y une astuce qui consiste à remplacer les formules de la zone à trier par leurs valeurs respectives avant de trier puis de redonner à la zone les formules telles qu'elle étaient lorsque le tri est terminé.

Pour stocker dans une variable les formules :

Code : Tout sélectionner

maVariable = maZone.FormulaArray
Pour remplacer les formules par leurs valeurs :

Code : Tout sélectionner

maZone.FormulaArray = maZonne.DataArray
et enfin lorsque le tri est terminé :

Code : Tout sélectionner

maZone.FormulaArray = maVariable

Re: [Calc] Filtre sans les formules

Publié : 20 mai 2019 15:37
par tomasi
Malheureusement je n’utilise pas xray. Cette solution est-elle quand viable ?

Re: [Calc] Filtre sans les formules

Publié : 20 mai 2019 15:41
par OOotremer971
tomasi a écrit :Malheureusement je n’utilise pas xray.
C'est bien dommage car xray te permet d'être beaucoup plus efficace en programmation.
tomasi a écrit :Cette solution est-elle quand viable ?
Bien entendu, le principe ne fait pas appel à xray pour fonctionner. Xray t’aurait juste servi à mieux comprendre ce qu'il se passe.

Re: [Calc] Filtre sans les formules

Publié : 20 mai 2019 16:24
par tomasi
Merci pour ton temps est ce que cela serait trop te demander de me montrer comment intégrer cette mzcro dans la mienne ? Encore merci de ton aide

Re: [Calc] Filtre sans les formules

Publié : 20 mai 2019 23:45
par OOotremer971
Par contre j'ai un soucis avec ton fichier que je ne reproduis pas avec un fichier vierge.
J'ignore si ton fichier contient des scories venues d'Excel ou d'un copier/coller à partir d'internet ou des surcharges de style, mais après exécution de la macro, les colonnes sur lesquelles tu as appliqué 2 décimales reviennent à un format à 4 ou 5 décimales.
Tu devrais sélectionner toute la feuille puis clic droit dans une cellule>>Effacer le formatage direct et créer des styles pour formater tes cellules.

Code : Tout sélectionner

Option Explicit
Sub Tri1


Dim oDoc as Object, fBase as Object, fSel1 as Object, fSel2 as Object
Dim maZone as Object, oFilterDesc as Object, maCellule as Object
Dim oFields(0) As New com.sun.star.sheet.TableFilterField
Dim CellVides as Variant, formules As Variant, y as Long

	oDoc = thisComponent
	fBase = oDoc.Sheets.getByName("Feuille1")
	fSel1 = oDoc.Sheets.getByName("Feuille2")
	fSel2 = oDoc.Sheets.getByName("Feuille3")
	maZone = fBase.getCellRangeByName("A1:A1000")
	CellVides = maZone.queryEmptyCells.RangeAddresses
	y = CellVides(UBound(CellVides)).StartRow
	maZone = fBase.getCellRangeByName("A1:Ak" & y)
	
	'=================================
	formules = maZone.GetFormulaArray
	maZone.SetFormulaArray(maZone.DataArray)
	'=================================
	
	oFilterDesc = maZone.createFilterDescriptor(True)
	With oFields(0)
		.Field = 36
		.IsNumeric = True
		.NumericValue = 1.8
		.Operator = com.sun.star.sheet.FilterOperator.GREATER_EQUAL
		
	End With
	With oFilterDesc
		.CopyOutputData = True
		.ContainsHeader = False
		.Orientation = com.sun.star.table.TableOrientation.COLUMNS
		maCellule = fSel1.getCellRangeByName("A1")
		.OutputPosition = maCellule.CellAddress
		.FilterFields = oFields()
	End With
	maZone.filter(oFilterDesc)
	oFilterDesc = maZone.createFilterDescriptor(True)
	With oFields(0)
		.Field = 36
		.IsNumeric = True
		.NumericValue = 0.2
		.Operator = com.sun.star.sheet.FilterOperator.LESS
	End With
	With oFilterDesc
		.CopyOutputData = True
		.ContainsHeader = False
		.Orientation = com.sun.star.table.TableOrientation.COLUMNS
		maCellule = fSel2.getCellRangeByName("A1")
		.OutputPosition = maCellule.CellAddress
		.FilterFields = oFields()
	End With
	maZone.filter(oFilterDesc)
	
	'==========================
	maZone.SetFormulaArray(formules)
	'==========================
	
End Sub

Re: [Calc] Filtre sans les formules

Publié : 21 mai 2019 07:55
par tomasi
Ce sont des données externes de site internet et donc effectivement la macro ne fonctionne pas car le tri est faussé.

Re: [Calc] Filtre sans les formules

Publié : 21 mai 2019 10:08
par OOotremer971
Bonjour,

Dans ce cas, si tu ne veux pas avoir les formules, il suffit d'écraser le résultat du filtrage par un copier/collage spécial en décochant formule.

Code : Tout sélectionner

Option Explicit
Sub Tri1


Dim oDoc as Object, fBase as Object, fSel1 as Object, fSel2 as Object
Dim maZone as Object, oFilterDesc as Object, maCellule as Object
Dim oFields(0) As New com.sun.star.sheet.TableFilterField
Dim CellVides as Variant, formules As Variant, y as Long

	oDoc = thisComponent
	fBase = oDoc.Sheets.getByName("Feuille1")
	fSel1 = oDoc.Sheets.getByName("Feuille2")
	fSel2 = oDoc.Sheets.getByName("Feuille3")
	maZone = fBase.getCellRangeByName("A1:A1000")
	CellVides = maZone.queryEmptyCells.RangeAddresses
	y = CellVides(UBound(CellVides)).StartRow
	maZone = fBase.getCellRangeByName("A1:Ak" & y)
	oFilterDesc = maZone.createFilterDescriptor(True)
	With oFields(0)
		.Field = 36
		.IsNumeric = True
		.NumericValue = 1.8
		.Operator = com.sun.star.sheet.FilterOperator.GREATER_EQUAL
		
	End With
	With oFilterDesc
		.CopyOutputData = True
		.ContainsHeader = False
		.Orientation = com.sun.star.table.TableOrientation.COLUMNS
		maCellule = fSel1.getCellRangeByName("A1")
		.OutputPosition = maCellule.CellAddress
		.FilterFields = oFields()
	End With
	maZone.filter(oFilterDesc)
	oFilterDesc = maZone.createFilterDescriptor(True)
	With oFields(0)
		.Field = 36
		.IsNumeric = True
		.NumericValue = 0.2
		.Operator = com.sun.star.sheet.FilterOperator.LESS
	End With
	With oFilterDesc
		.CopyOutputData = True
		.ContainsHeader = False
		.Orientation = com.sun.star.table.TableOrientation.COLUMNS
		maCellule = fSel2.getCellRangeByName("A1")
		.OutputPosition = maCellule.CellAddress
		.FilterFields = oFields()
	End With
	maZone.filter(oFilterDesc)
	maZone = fSel2.getCellRangeByName("A1:A1000")
	y = CellVides(UBound(CellVides)).StartRow
	CopierCollerSpecial(y)
End Sub


sub CopierCollerSpecial(derLigne)
dim document   as object
dim dispatcher as object
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
dim args1(0) as new com.sun.star.beans.PropertyValue
dim args3(5) as new com.sun.star.beans.PropertyValue
args1(0).Name = "ToPoint"
args1(0).Value = "A1:Ak"&derLigne
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, args1())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
args3(0).Name = "Flags"
args3(0).Value = "SVDT"
args3(1).Name = "FormulaCommand"
args3(1).Value = 0
args3(2).Name = "SkipEmptyCells"
args3(2).Value = false
args3(3).Name = "Transpose"
args3(3).Value = false
args3(4).Name = "AsLink"
args3(4).Value = false
args3(5).Name = "MoveMode"
args3(5).Value = 4
dispatcher.executeDispatch(document, ".uno:InsertContents", "", 0, args3())
end sub
A+
Fuseau horaire sur UTC
Page 1 sur 1

Développé par phpBB® Forum Software © phpBB Limited

Traduction française officielle © Qiaeru