LO Basic

fr-users
#1

Bonjour,

Je cherche le code qui permettrait dans un classeur calc, d'accéder à un diagramme et de l'éditer.
Merci d'avance
Cordialement

#2

Bonjour,

Dans les exemples de bases de données du Guide Base, il y a une base avec un diagramme inclus dans un formulaire, peuplé avec une macro.

Tu pourras peut-être y trouver ce que tu cherches.

Cordialement

JMC

#3

Bonjour,

Dans les exemples de bases de données du Guide Base, il y a une base avec un diagramme inclus dans un formulaire, peuplé avec une macro.

Tu pourras peut-être y trouver ce que tu cherches.

Edit : oubli du lien, https://wiki.documentfoundation.org/images/d/da/Exemples_Base_64.zip

Cordialement

JMC

#4

Bonjour,

Ci-joint mes bouts d'exemple à de-scripter

Sans garantie SAV

Cordialement

Jean-Luc

Option Explicit
' retrouve un objet diagramme à partir du nom de l'objet
Function FindChartByObjName(laFeuille As Object, nomDiag As String, sv As String) As Object  '--1 ------------------------------  1---
 Dim dessin As Object
 Dim nomDuDiagrammeCalcFCBON
 ' sv = "com.sun.star.drawing.OLE2Shape" 23/6/2020
 '  com.sun.star.table.XTableCharts com.sun.star.drawing.OLE2Shape
 dessin = FindObjectByName(laFeuille.Drawpage, nomDiag, sv)

'Print ("dessin recherche object 1 " & nomDiag & " " &  sv )

'Xray dessin
 'Xray laFeuille

nomDuDiagrammeCalcFCBON=dessin.PersistName
 'print (nomDuDiagrammeCalcFCBON)

' sv = "com.sun.star.table.XTableCharts" 23/6/2020
 '  com.sun.star.table.XTableCharts com.sun.star.drawing.OLE2Shape
' Xray laFeuille.Charts
 dessin = laFeuille.Charts.getByName(nomDuDiagrammeCalcFCBON) ' FindObjectByName(laFeuille.Charts, nomDuDiagrammeCalcFCBON, sv)
' Xray dessin
 if not IsNull(dessin) then
  ' if dessin.Model.supportsService("com.sun.star.chart.ChartDocument") then
     FindChartByObjName = dessin '.Model
  ' end if
  Else
  print ("erreur pas de diagramme")
  Xray dessin
 end if
End Function ' renvoie Null en cas d'échec FindChartByObjName -- 1 ------------------------------------------------  1 --

' retrouve un objet à partir de son nom
Function FindObjectByName(unePage As Object,nomObj As String, Optional service As String) As Object  ' 2  -----------  2
  '  com.sun.star.table.XTableCharts com.sun.star.drawing.OLE2Shape
 Dim objX, SousObjectFOBN As Object
 Dim NomObjetFOB, ListeDesObjectsFOBN As String
 Dim jFOBN, iFOBN, CompteurFOBN, CompteurDepartFOBN, x, y As Long
 ListeDesObjectsFOBN="Nbre object dans page initiale " & unePage.Count & " | Object à trouver " & nomObj & " | "
 y=0
 If nomObj="" Then
   Print ("erreur le nom de l'object est vide " & nomObj)
 End If
 CompteurDepartFOBN = unePage.Count
 For jFOBN=0 To 1
  If jFOBN=1 Then
      ' print("Les compteurs " & CompteurDepartFOBN & " " & unePage.Count)
  End If
  For x = 0 To unePage.Count - 1
   objX = unePage(x)
   ' Object                                 | supportsService              | Count
   ' com.sun.star.comp.sc.ScShapeObj"      | com.sun.star.drawing.OLE2Shape       |  non
   ' SwXTextGraphicObject                   | com.sun.star.text.TextGraphicObject  |  non
   ' SwXTextTable                           | com.sun.star.text.TextTable          |  non
   ' com.sun.star.drawing.XDrawPage         | com.sun.star.drawing.GenericDrawPage |  oui

'   'com.sun.star.drawing.RotationDescriptor 'com.sun.star.drawing.ShadowProperties 'com.sun.star.drawing.Shape 'com.sun.star.drawing.Text
      'com.sun.star.drawing.TextProperties , 'com.sun.star.sheet.Shape com.sun.star.drawing.XDrawPage

If objX.supportsService("com.sun.star.text.TextTable") or objX.supportsService("com.sun.star.text.TextGraphicObject") or objX.supportsService( "com.sun.star.drawing.OLE2Shape")_
    Then ' or objX.supportsService("com.sun.star.text.TextGraphicObject") Then ' or True
     CompteurFOBN = 0 ' com.sun.star.comp.sc.ScShapeObj
     SousObjectFOBN = objX
    ElseIf objX.supportsService("com.sun.star.drawing.GenericDrawPage") Then
     CompteurFOBN = objX.Count - 1
     ListeDesObjectsFOBN= ListeDesObjectsFOBN & " | Nbre d'object dans page | " & objX.Count
     SousObjectFOBN = objX(0)
     Print ("objet multiple "  & CompteurFOBN)
     Xray SousObjectFOBN
    Else
     CompteurFOBN = 0
     Print ("noter le service et vérifier si il y a Count")
     Xray objX
   End If
   For iFOBN = 0 To CompteurFOBN
    y=y+1
    NomObjetFOB = SousObjectFOBN.Name
    ListeDesObjectsFOBN= ListeDesObjectsFOBN &" | " & x & " | " &  NomObjetFOB
    If SousObjectFOBN.Name = nomObj Then
      If IsMissing(service) then
        FindObjectByName = SousObjectFOBN ' objet trouvé
        Print (" Name ? et copier un service")
        Xray  SousObjectFOBN 'com.sun.star.sheet.SpreadsheetDrawPage
        Print("Stop")
        jFOBN = 1
        x = unePage.Count - 1
       Else
        If SousObjectFOBN.supportsService(service) then
          FindObjectByName = SousObjectFOBN ' objet trouvé
          jFOBN=1
          x = unePage.Count - 1
        End If
      End If
    End If
    SousObjectFOBN = objX(iFOBN)
    If iFOBN <> 0 or IsEmpty (SousObjectFOBN)  Or IsNull(SousObjectFOBN) Then
      Print ("objet multiple suite "  & CompteurFOBN)
      Xray SousObjectFOBN
      Xray objX
    End If
   Next iFOBN
  Next x
  '
 Next jFOBN
 If IsEmpty (FindObjectByName)  Or IsNull(FindObjectByName) Then    ' nomObj="EP214" Or nomObj="CO048"
   Print("Object n'est pas trouvé, Liste des objects " & ListeDesObjectsFOBN)
   print("Les compteurs " & CompteurDepartFOBN & " " & unePage.Count)
   'Xray SousObjectFOBN
   Xray objX
   Xray unePage

End If

End Function ' renvoie Null en cas d'échec FindObjectByName 2 -----------------------------------------------------   2

'sub Creationgraphe()

'end sub
'   3