Bonsoir Laurence,
De visu ton code à l'air pas mal, et peut-être pourrais-tu le structurer
un peu différemment pour qu'il offre une lecture plus aisée car ta
soumission en intéressera quelques uns.
Par ailleurs, je t'invite à consulter cet excellent exemple qui
t'apporteras sans doute des idées, notamment dans la possibilité de
sélectionner une plage à la souris.
http://homepages.paradise.net.nz/hillview/OOo/MyDataPilot.sxc
Le code est ancien mais démonstratif ;)
Merci pour tes scripts.
Francois Gatto
BOTTIN Laurence - DGMT/SG/AG2 a écrit :
Bonjour,
Je vous transmets 2 macros, qui permettent de créer et de mettre à jour
un pilote de données.
Je les aie testés et elles fonctionnent, j'ai essayé de traduire les
commentaires anglais pour que la compréhension en soit facilitée. merci
de me faire part de vos commentaires.
Sub MajPiloteDonnees()
Dim oCalc As object
Dim oFeuille As Object
Dim oPilotDonnees As Object
Dim oPilotDonDesc As Object
Dim monPilotDonn As Object
Dim Ranges
Dim NomFeuilData
dim newrange As new com.sun.star.table.CellRangeAddress 'une plage
de données
Dim LigneDeb
Dim ColonneDeb
NomFeuilData=("feuille1")
LigneDeb = 0
ColonneDeb = 0
oCalc = ThisComponent
'mon pilote est sur la 3ème feuille
oFeuille = oCalc.getSheets().getByIndex(2)
oPilotDonnees = oFeuille.getDataPilotTables()
monPilotDonn =
oFeuille.getDataPilotTables().getbyname("DataPilotExample")
'on récupère la plage de données
ranges = monPilotDonn.getSourceRange ()
actualrange = ranges(0)
Feuille = actualrange.sheet
ColonneDeb = actualrange.StartColumn
ColonneFin = actualrange.EndColumn
ligneDeb = actualRange.StartRow
LigneFin = actualRange.EndRow
'on compte le nombre de ligne de la nouvelle plage de données
'sur laquelle on veut faire pointer le diagramme
NbLignes = F_LongueurTable(NomFeuilData, LigneDeb, ColonneDeb)
'on définit la zone de données utilisée pour actualiser le diagramme :
newRange.sheet = Feuille
newRange.StartColumn = ColonneDeb
newRange.EndColumn = ColonneFin
newRange.startRow = ligneDeb
newRange.EndRow = ligneDeb + NbLignes - 1
'on applique les propriétés de la nouvelle plage à la plage de
données du graphique
ranges(0) = newRange
monPilotDonn.setSourceRange(ranges)
monPilotDonn.refresh()
End sub
Sub CreerPiloteDonnees()
' create a new DataPilot
Dim oDoc As Object
Dim xSheet As Object
' get doc and sheet
oDoc = ThisComponent
xSheet = oDoc.getSheets().getByIndex(0)
'on récupère la collection des pilotes de données
Dim xDPTables As Object
xDPTables = xSheet.getDataPilotTables()
' on créer un descripteur de table de données
Dim xDPDesc As Object
xDPDesc = xDPTables.createDataPilotDescriptor()
'on ignore les lignes vides
xDPDesc.IgnoreEmptyRows=True
' donner les coordonnées de la zone de cellule
Dim aSourceAddress As New com.sun.star.table.CellRangeAddress
aSourceAddress.Sheet = 0
aSourceAddress.StartColumn = 0
aSourceAddress.StartRow = 0
aSourceAddress.EndColumn = 12
aSourceAddress.EndRow = 19
'on applique les coordonnées de la zone de cellule au descripteur
xDPDesc.setSourceRange(aSourceAddress)
' on récupère la collection de champs du descripteur de pilote de
données
Dim xFields As Object
xFields = xDPDesc.getDataPilotFields()
'on défini les propriétés de chaque champs
Dim aFieldObj As Object
' Déclarer la 2ème colonne comme champs de colonne (catégorie)
aFieldObj = xFields.getByIndex(1)
aFieldObj.setPropertyValue("Orientation",
com.sun.star.sheet.DataPilotFieldOrientation.COLUMN)
aFieldObj.setName("Catégorie")
' Déclarer la 1ère colonne comme champs de ligne (mouvement)
aFieldObj = xFields.getByIndex(0)
aFieldObj.setPropertyValue("Orientation",
com.sun.star.sheet.DataPilotFieldOrientation.ROW)
aFieldObj.setPropertyValue("Function", 1)
'Déclarer la 3ème colonne comme champs de ligne (libellé)
aFieldObj = xFields.getByIndex(2)
aFieldObj.setPropertyValue("Orientation",
com.sun.star.sheet.DataPilotFieldOrientation.ROW)
' déclarer le champs de données nombre (on compte le nombre de noms)
aFieldObj = xFields.getByIndex(3)
aFieldObj.setPropertyValue("Orientation",
com.sun.star.sheet.DataPilotFieldOrientation.DATA)
aFieldObj.setPropertyValue("Function",
com.sun.star.sheet.GeneralFunction.COUNT)
'déclarer le champs de données somme des JB
aFieldObj = xFields.getByIndex(5)
aFieldObj.setPropertyValue("Orientation",
com.sun.star.sheet.DataPilotFieldOrientation.DATA)
aFieldObj.setPropertyValue("Function",
com.sun.star.sheet.GeneralFunction.SUM)
'déclarer le champs de données age moyen
aFieldObj = xFields.getByIndex(10)
aFieldObj.setPropertyValue("Orientation",
com.sun.star.sheet.DataPilotFieldOrientation.DATA)
aFieldObj.setPropertyValue("Function",
com.sun.star.sheet.GeneralFunction.AVERAGE)
'on définit la plage de cellule où sera créé le pilote de données
Dim aDestAddress As New com.sun.star.table.CellAddress
aDestAddress.Sheet = 2
aDestAddress.Column = 0
aDestAddress.Row = 0
'on créé le nouveau pilote de données (nom , emplacement , description)
xDPTables.insertNewByName("DataPilotExample", aDestAddress, xDPDesc)
End Sub
Function F_LongueurTable(vp_strNomFeuilData As String, Optional vp_start
As Variant, Optional vp_col As Variant) As Long
'Date création: 12/10/2001 Auteur: CEO
'Date modification 12/01/2007 Auteur : DGMT/SG/AG2 - LB
Dim vl_strNomFeuilData As String
Dim vl_start As Long
Dim vl_col As Long
Dim i As Long
Dim lesFeuilles as Object
Dim maFeuille as Object
Dim toto as string
Dim maCellule as Object
On Error GoTo Erreurs
vl_start = CLng(vp_start)
vl_col = CLng(vp_col)
i = vl_start
maFeuille = thisComponent.sheets.getByName(vp_strNomFeuilData)
maCellule = maFeuille.getCellByPosition( vl_col, i)
toto = maCellule.String
While toto <> ""
i = i + 1
maCellule=maFeuille.getCellByPosition(vl_col, i)
toto = maCellule.String
Wend
F_LongueurTable = i - vl_start
Exit Function
Erreurs:
erreur_num=err()
erreur_txt=error(erreur_num)
erreur_ligne = Erl()
MsgBox(vl_projet & " :" & Chr(10) & Chr(10) & "erreur n° " +
erreur_num + " à la ligne " + erreur_ligne + chr(13) + erreur_txt, 1 +
16, " F_LongueurTable")
End Function
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
