[Résolu][Calc] Diagramme Charts: en-têtes lignes et colonnes

[ThierryM]

Bonjour à tous et à toutes,
Je veux actualiser un diagramme existant (pour passer de 19 lignes de données à 16) via la macro ci-dessous.

Sélection_830.png

Mon problème réside dans le fait que ce diagramme (qui a été conçu manuellement avec des en-têtes de lignes et de colonnes), lors de l'actualisation perd cette indication. Les propriétés HasColumnHearders et HasRowHeaders qui étaient à "True" passent à "False", du coup le diagramme reste vide.
J'ai essayé de modifier avec la macro ces propriétés à la valeur "True" mais ça n'a aucun effet (la valeur reste à "False").

Code : Tout sélectionner

Sub GraphiqueIndiv
'Macro pour actualiser le graphique individuel d'un élève (notamment le nombre de jours variables selon les mois
 monClasseur=thisComponent
 fIndiv=monClasseur.Sheets.getByName("Fiche Individuelle")
 eleve=fIndiv.getCellRangeByName("C4").String
 dateDeb=fIndiv.getCellRangeByName("D14").String
 dateFin=fIndiv.getCellRangeByName("D15").String
 nbDates=(fIndiv.getCellRangeByName("D16").value)/2 'Nombre de jours d'école
 premiereLigne=20
 derniereLigne=premiereLigne+nbDates
 ch=fIndiv.Charts(0)
 lesZones=ch.Ranges
 
 For z=0 to 4
 	adrZ=lesZones(z)
 	'xray adrZ
 	adrZ.EndRow=derniereLigne
 	'xray adrZ
 	lesZones(z)=adrZ
 Next z
 
 'xray ch
 ch.Ranges=lesZones 'Enregistre les nouvelles zones du graphique -> COMMANDE QUI LANCE L'ACTUALISATION (à commenter si on ne veut pas)
 ch.HasColumnHeaders=True
 ch.HasRowHeaders=True 
 'xray ch
  
 diag1=fIndiv.Charts(0).EmbeddedObject
 diag1.Title.String= "Fréquentation de " & eleve & " du " & dateDeb & " au " & dateFin

End Sub

Je vous joins le fichier exemple pour vous faire une idée. Normalement l'actualisation devrait faire que les 3 colonnes blanches à la fin du diagramme disparaissent pour que ça correspondent aux jours listés au-dessous. Pour info, j'utilise la coloration des colonnes :

Plages de données_829.png

Merci pour vos éclairages, cordialement,
Thierry

Edit du 18/11 : simplification de la macro vu que seule la propriété EndRow change.

[ThierryM]

Re-Adieu a totes,

Remarque : je poste à la suite (après avoir édité plusieurs fois mon premier post) pour montrer mon cheminement et que le fil soit plus lisible avec le rajout d'informations nouvelles sur des propriétés très peu documentées sur le net. Merci aux gentils Modoo de ne pas me rappeler les règles .

J'ai un peu avancé dans mes recherches car je ne prenais pas en compte la propriété "RelatedCellRanges" qui lors de l'actualisation de la propriété "Ranges" est impactée.
De plus, le fait de changer les propriétés HasColumnHearders et HasRowHeaders impacte aussi la propriété "RelatedCellRanges" alors qu'elles restent à "False" !!!
Voici le nouveau code avec les appels Xray montrant ce que j'annonce :

Code : Tout sélectionner

Sub GraphiqueIndiv
'Macro pour actualiser le graphique individuel d'un élève (notamment le nombre de jours variables selon les mois
 monClasseur=thisComponent
 fIndiv=monClasseur.Sheets.getByName("Fiche Individuelle")
 eleve=fIndiv.getCellRangeByName("C4").String
 dateDeb=fIndiv.getCellRangeByName("D14").String
 dateFin=fIndiv.getCellRangeByName("D15").String
 nbDates=(fIndiv.getCellRangeByName("D16").value)/2 'Nombre de jours d'école
 premiereLigne=20
 derniereLigne=premiereLigne+nbDates
 ch=fIndiv.Charts(0)
 
 lesZones=ch.Ranges 
  For z=0 to 4
	adrZ=lesZones(z)
	adrZ.EndRow=derniereLigne
	lesZones(z)=adrZ
 Next z
 xray ch 'indique HasColumnHeaders=True et HasRowHeaders=True
 xray ch.RelatedCellRanges 'indique 7 zones
 ch.Ranges=lesZones 'APPLIQUE LES CHANGEMENTS
 xray ch 'indique HasColumnHeaders=False et HasRowHeaders=False
 xray ch.RelatedCellRanges 'indique 5 zones 
 ch.HasColumnHeaders=True 'sans effet
 ch.HasRowHeaders=True 'sans effet
 xray ch 'indique HasColumnHeaders=False et HasRowHeaders=False
 
 Dim lesZonesRel(6) As New com.sun.star.table.CellRangeAddress 'pour pouvoir créer 2 nouvelles séries
 lesZonesRel(0)=lesZones(0)
 With lesZonesRel(1)
 	.EndColumn=15
 	.EndRow=premiereLigne
 	.Sheet=6
 	.StartColumn=15
 	.StartRow=premiereLigne 
 End With
 lesZonesRel(2)=lesZones(1)
 lesZonesRel(3)=lesZones(2)
 With lesZonesRel(4)
 	.EndColumn=6
 	.EndRow=premiereLigne
 	.Sheet=6
 	.StartColumn=0
 	.StartRow=premiereLigne
 End With
 LesZonesRel(5)=lesZones(3)
 lesZonesRel(6)=lesZones(4)
 
 ch.RelatedCellRanges=lesZonesRel 'APPLIQUE LES CHANGEMENTS
 xray ch 'indique HasColumnHeaders=False et HasRowHeaders=False
 ch.HasColumnHeaders=True 'Réinitialise RelatedCellRanges à 4 séries
 ch.HasRowHeaders=True ''Réinitialise RelatedCellRanges à 4 séries
 xray ch 'indique HasColumnHeaders=False et HasRowHeaders=False
 xray ch.RelatedCellRanges 'indique à nouveau 5 zones !!!

 diag1=fIndiv.Charts(0).EmbeddedObject
 diag1.Title.String= "Fréquentation de " & eleve & " du " & dateDeb & " au " & dateFin
End Sub

Je vous joins une nouvelle version du fichier contenant ce code pour que vous vous "amusiez" si ça vous intéresse .
Je ne vois pas comment faire : est-ce un boggue ?

[ThierryM]

Re-Adieu,

Bon, j'ai résolu mon problème mais la solution est beaucoup plus complexe que ce que j'avais imaginé : en fait, après une modification (extension) de la plage de données, il faut tout ré-ordonner. J'ai trouvé la solution ici : https://ask.libreoffice.org/en/question ... ata-range/ dans le fichier joint https://ask.libreoffice.org/upfiles/147 ... 817557.ods .
Voici le code adapté à mon cas :

Code : Tout sélectionner

REM  *****  BASIC  *****
'Macros trouvée ici : https://ask.libreoffice.org/en/question/75127/macro-change-categories-data-range/
'Permet de mettre à jour les diagrammes

Sub UpdateDocChartRanges
 monClasseur=thisComponent
 fIndiv=monClasseur.Sheets.getByName("Fiche Individuelle")
 eleve=fIndiv.getCellRangeByName("C4").String
 dateDeb=fIndiv.getCellRangeByName("D14").String
 dateFin=fIndiv.getCellRangeByName("D15").String
 nbDates=(fIndiv.getCellRangeByName("D16").value)/2 'Nombre de jours d'école
 premiereLigne=22
 derniereLigne=premiereLigne+nbDates
 ch=fIndiv.Charts(0)
 'Replace chart datasequences of chart series		
 UpdateChartRanges( ch, premiereLigne, derniereLigne-1)
End Sub

Sub UpdateChartRanges( oChart As Object, iFirstRow As Long, iLastRow As Long )

	Dim oChartDoc As Object
	
	Dim oDataProvider As Object
	Dim oCooSys As Object
	Dim oCoods As Object
	Dim oChartTypes As Object
	Dim oChartType As Object
	Dim oDataSeriesList As Variant
	
	Dim oDataSequence As Object
	Dim oValues As Object
	Dim oNewDataSeries() As Object
	Dim oSequenceY As Object
	Dim oSequenceLabel As Object
	
	Dim i As Integer
	Dim n As Integer
	
	Dim bCategories As Boolean
	
	Dim il As Integer
	Dim iu As Integer
	Dim vSequences() As Object
	Dim bFirstRowLabel As Boolean
	Dim oRange As Object

	oChartDoc = oChart.EmbeddedObject
	
	oDataProvider = oChartDoc.getDataProvider()
	
	oCooSys = oChartDoc.getFirstDiagram().getCoordinateSystems()
	oCoods = oCooSys(0) ' this chart has only a coordinate system
	
	oChartTypes = oCoods.getChartTypes() ' chart type one by one
	oChartType = oChartTypes(0)
	
	' all data series belongs the chart type
	oDataSeriesList = oChartType.getDataSeries()
	
	' Save and then disable categories so we can treat them as series and restore later
	bCategories = oChartDoc.DataSourceLabelsInFirstColumn
		
	' Record if first row is label
	bFirstRowLabel = oChartDoc.DataSourceLabelsInFirstRow
		
	ReDim oNewDataSeries(lbound(oDataSeriesList) To ubound(oDataSeriesList)) As Object
	
	' For each series in the chart
	For i = lbound(oDataSeriesList) To ubound(oDataSeriesList)
		' create new DataSeries
		oNewDataSeries(i) = CreateUnoService("com.sun.star.chart2.DataSeries")
		
		' Copy the existing formatting of this series
		oNewDataSeries(i) = oDataSeriesList(i)
		
		il = lbound(oNewDataSeries(i).DataSequences)
		iu = ubound(oNewDataSeries(i).DataSequences)
		
		ReDim vSequences(il To iu) As Object
		
		' Update each data sequence in each series
		For n = il To iu
			oDataSequence = oNewDataSeries(i).DataSequences(n)
			
			vSequences(n) = CreateUnoService("com.sun.star.chart2.data.LabeledDataSequence")

			oSequenceY = CreateDataSequence(oDataProvider, _
											UpdateSeriesRange( oDataSequence.Values.SourceRangeRepresentation, iFirstRow, iLastRow ), _
											oDataSequence.Values.Role)
			
			If NOT IsNull(oSequenceY) Then
				vSequences(n).setValues(oSequenceY)
				
				If NOT IsNull(oDataSequence.Label) Then
					oSequenceLabel = CreateDataSequence(oDataProvider, oDataSequence.Label.SourceRangeRepresentation, "")
					
					vSequences(n).setLabel(oSequenceLabel) ' label is used as name
				End If
			End If
		Next n
		
		oNewDataSeries(i).setData(vSequences)
	Next i
		
	If bCategories Then
		'	Change the range of the category data
		oRange = oChart.Ranges(0)
		
		If bFirstRowLabel Then
			oRange.StartRow = 22
		Else
			oRange.StartRow = 21
		End If
		
		oRange.EndRow = iLastRow - 1
		
		'	Set the new category data range in the chart data range
		oChart.Ranges = Array(oRange)
		
		'	Put the data series back in the chart
		oChartType.DataSeries = oNewDataSeries
	End If
End Sub

Function UpdateSeriesRange( ByRef sRange As String, iFirstRow As Long, iLastRow As Long ) As String
	Dim sUpdateSeriesRange As String
	Dim iColon As Integer
	Dim iDot As Integer
	Dim iFirst As Integer
	Dim iLast As Integer
	'xray sRange
	iColon = InStr( sRange, ":" )
	iDot = InStr( sRange, "." )
	iFirst = InStr( Mid( sRange, iDot + 2 ), "$" ) +iDot + 1
	iLast = InStr( Mid( sRange, iColon + 2 ), "$" ) + iColon + 1
	sUpdateSeriesRange = Left( sRange, iFirst ) & Format( iFirstRow, "0" ) & Mid( sRange, iColon, iLast - iColon + 1 ) & Format (iLastRow, "0" )
	UpdateSeriesRange = sUpdateSeriesRange
End Function

Function CreateDataSequence( _
	oDataProvider As Object, _
	sRangeRepresentation As String, sRole As String ) As Object

'	Based on post by Hanya
'	https://forum.openoffice.org/en/forum/viewtopic.php?f=20&t=8991#p46467

' creat new DataSequence from range representaion
' that provides real data and its role in the series
' oDataProvider: com.sun.star.chart2.data.XDataProvider
' sRangeRepresentation: range address e.g. Sheet1.A1:B2
' sRole: role is defined in com.sun.star.chart2.data.DataSequenceRole

	Dim oDataSequence As Object
	
	On Error GoTo Handler
	' create .chart2.data.DataSequence from range representation
	oDataSequence = oDataProvider.createDataSequenceByRangeRepresentation(sRangeRepresentation)

	If NOT IsNull(oDataSequence) Then
		oDataSequence.Role = sRole
	End If
	
Handler:
	CreateDataSequence = oDataSequence
End Function

En espérant que ça puisse servir à d'autres, cordialement,

Thierry