PureBoard

Das deutsche PureBasic-Forum
https://www.purebasic.fr/german/

Excel Chart + Spreadsheet in PB erzeugen und darstellen

https://www.purebasic.fr/german/viewtopic.php?t=18980

Seite 5 von 5

Verfasst: 30.01.2009 14:36
von Kiffi
so, hier ist der Ausschnitt zwischen ";####..." und "HideWindow(0,0)":

Code: Alles auswählen

  Define myChart.COMateObject
  Define ChartSpace.COMateObject
  Define mySeriesCollection.COMateObject

  ChartSpace=COMate_CreateActiveXControl(0,400,800,400,"OWC11.ChartSpace")
  
  If ChartSpace
    
    ChartSpace\SetProperty("DisplayOfficeLogo = #True")
    ChartSpace\SetProperty("DisplayToolbar = #True")
    ChartSpace\SetProperty("AllowPropertyToolbox = #True")
    
    ChartSpace\SetProperty("HasChartSpaceTitle = #True")
    ChartSpace\SetProperty("ChartSpaceTitle\Caption = 'Overview'")
    ChartSpace\SetProperty("ChartSpaceTitle\Font\Bold = #True")
    ChartSpace\SetProperty("ChartSpaceTitle\Font\Underline = #True")
    
    ChartSpace\SetProperty("SeriesCollection\Type = 6") ;6=chChartTypeLine
    ChartSpace\SetProperty("DataSource = " + Str(ExcelObject) + " As COMateObject")
    
    myChart = ChartSpace\GetObjectProperty("Charts\Add")
    
    If myChart
      
      myChart\SetProperty("Type = 6") ; 6 = chChartTypeLine
      
      mySeriesCollection = myChart\GetObjectProperty("SeriesCollection\Add")
      
      If mySeriesCollection
        
        mySeriesCollection\Invoke("SetData( 0, 0, 'B1')")  ;0 = chDimSeriesNames
        mySeriesCollection\Invoke("SetData( 1, 0, 'A1:B1')") ;1 = chDimCategories
        mySeriesCollection\Invoke("SetData( 2, 0, 'A2:B2')") ;2=chDimValues
      
        mySeriesCollection\Release()
        
      Else
        
        Debug "!mySeriesCollection"
        
      EndIf
      
      myChart\Release()
      
    Else
      
      Debug "!myChart"
      
    EndIf
    
  EndIf

(ich habe jetzt nicht gesondert darauf geachtet, ob in Deinen Befehlen
noch ein Fehler steckt, sondern lediglich dafür gesorgt, dass die Daten
angezeigt werden).

Grüße ... Kiffi

// Edit:
CNESM hat geschrieben:VBA:

Code: Alles auswählen

ChartSpace1.DataSource = Spreadsheet1
PB:

Code: Alles auswählen

ExcelObject1\SetProperty("DataSource = 'Spreadsheet1'")
na, das mit dem String wird so nicht klappen.
Du musst natürlich ein Objekt übergeben.

Verfasst: 30.01.2009 15:19
von CNESM
Wirklich gut umgesetzt, zumal ich das jetzt auch mehr verstehe und erkenne, wo mein Fehler lag. Der Hauptfehler lag also wirklich an der Datasource-Übergabe, da die Angabe von mir nicht als Object erkannt wurde. Jetzt hab ich endlich nen funktionierendes Grundgerust, das ich mir zur Hilfe nehmen kann. Vielleicht sollte man den komplette Code auch ins CodeArchiv stellen. Ist ne sehr gute Lösung und gut anzuschauen:

Code: Alles auswählen

IncludePath "...\"
XIncludeFile "COMate.pbi"

ExcelObject.COMateObject
ExcelObject1.COMateObject

If OpenWindow(0,#PB_Ignore,#PB_Ignore,800,800,"COMate: OWC11.Spreadsheet-Demo",#PB_Window_Invisible|#PB_Window_SystemMenu)
    
  ExcelObject=COMate_CreateActiveXControl(0,0,800,400,"OWC11.Spreadsheet")
  
  If ExcelObject
  
    ExcelObject\SetProperty("Cells(1,1) = 'Özgür'")
    ExcelObject\SetProperty("Cells(1,2) = 'Levent'")
    ExcelObject\SetProperty("Cells(2,1) = 10")
    ExcelObject\SetProperty("Cells(2,2) = 20")
    
    ExcelObject\SetProperty("Cells(1, 1)\Interior\Color = 18915966")
    ExcelObject\SetProperty("Cells(1, 2)\Interior\Color = 18915966")
    ExcelObject\SetProperty("Cells(2, 1)\Interior\Color = 18915966")
    ExcelObject\SetProperty("Cells(2, 2)\Interior\Color = 18915966")
    
    ExcelObject\SetProperty("Cells(1, 1)\Font\Color = 255255255")
    ExcelObject\SetProperty("Cells(1, 2)\Font\Color = 255255255")
    ExcelObject\SetProperty("Cells(2, 1)\Font\Color = 255255255")
    ExcelObject\SetProperty("Cells(2, 2)\Font\Color = 255255255")
    
    ExcelObject\GetObjectProperty("Sheets('3')\Delete")
    ExcelObject\GetObjectProperty("Sheets('2')\Delete")
  
    ExcelObject\SetProperty("Cells(1, 1)\HorizontalAlignment = -4152") ;-4152 = xlRight
    ExcelObject\SetProperty("Cells(1, 2)\HorizontalAlignment = -4152") ;-4152 = xlRight
    ExcelObject\SetProperty("Cells(2, 1)\HorizontalAlignment = -4152") ;-4152 = xlRight
    ExcelObject\SetProperty("Cells(2, 2)\HorizontalAlignment = -4152") ;-4152 = xlRight
    
    
    ExcelObject\SetProperty("Cells(1, 1)\Borders(7)\LineStyle = 1") ;7 = xlEdgeLeft ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(1, 1)\Borders(8)\LineStyle = 1") ;8 = xlEdgeTop ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(1, 1)\Borders(9)\LineStyle = 1") ;9 = xlEdgeBottom ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(1, 1)\Borders(10)\LineStyle = 1") ;10 = xlEdgeRight ; 1 = xlContinuous
    
    ExcelObject\SetProperty("Cells(1, 2)\Borders(7)\LineStyle = 1") ;7 = xlEdgeLeft ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(1, 2)\Borders(8)\LineStyle = 1") ;8 = xlEdgeTop ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(1, 2)\Borders(9)\LineStyle = 1") ;9 = xlEdgeBottom ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(1, 2)\Borders(10)\LineStyle = 1") ;10 = xlEdgeRight ; 1 = xlContinuous
    
    ExcelObject\SetProperty("Cells(2, 1)\Borders(7)\LineStyle = 1") ;7 = xlEdgeLeft ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(2, 1)\Borders(8)\LineStyle = 1") ;8 = xlEdgeTop ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(2, 1)\Borders(9)\LineStyle = 1") ;9 = xlEdgeBottom ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(2, 1)\Borders(10)\LineStyle = 1") ;10 = xlEdgeRight ; 1 = xlContinuous
    
    ExcelObject\SetProperty("Cells(2, 2)\Borders(7)\LineStyle = 1") ;7 = xlEdgeLeft ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(2, 2)\Borders(8)\LineStyle = 1") ;8 = xlEdgeTop ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(2, 2)\Borders(9)\LineStyle = 1") ;9 = xlEdgeBottom ; 1 = xlContinuous
    ExcelObject\SetProperty("Cells(2, 2)\Borders(10)\LineStyle = 1") ;10 = xlEdgeRight ; 1 = xlContinuous
    
    ExcelObject\SetProperty("Cells(1, 1)\Borders(7)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(1, 1)\Borders(8)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(1, 1)\Borders(9)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(1, 1)\Borders(10)\Weight = 2") ;2 = xlThin
    
    ExcelObject\SetProperty("Cells(1, 2)\Borders(7)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(1, 2)\Borders(8)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(1, 2)\Borders(9)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(1, 2)\Borders(10)\Weight = 2") ;2 = xlThin
    
    ExcelObject\SetProperty("Cells(2, 1)\Borders(7)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(2, 1)\Borders(8)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(2, 1)\Borders(9)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(2, 1)\Borders(10)\Weight = 2") ;2 = xlThin
    
    ExcelObject\SetProperty("Cells(2, 2)\Borders(7)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(2, 2)\Borders(8)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(2, 2)\Borders(9)\Weight = 2") ;2 = xlThin
    ExcelObject\SetProperty("Cells(2, 2)\Borders(10)\Weight = 2") ;2 = xlThin
    
    ExcelObject\SetProperty("DisplayToolbar = #False")
    ExcelObject\SetProperty("ScreenUpdating = #True")
    ExcelObject\SetProperty("ViewOnlyMode = #True") ;Schreibschutz
    ExcelObject\SetProperty("DisplayOfficeLogo = #False")
    ExcelObject\SetProperty("DisplayTitleBar = #False")
    ExcelObject\SetProperty("ActiveWindow\ViewableRange = 'A1:B2'")
    ExcelObject\SetProperty("ActiveWindow\DisplayWorkbookTabs = #False") 
  Else
    
    Debug "!mySpreadsheet"
      
  EndIf
  
  ;##############################################################
  
  Define myChart.COMateObject 
  Define ChartSpace.COMateObject 
  Define mySeriesCollection.COMateObject 
  
  ChartSpace=COMate_CreateActiveXControl(0,400,800,400,"OWC11.ChartSpace") 
  
  If ChartSpace 
    
    ChartSpace\SetProperty("DisplayOfficeLogo = #False") 
    ChartSpace\SetProperty("DisplayToolbar = #False") 
    ChartSpace\SetProperty("AllowPropertyToolbox = #False") 
    ChartSpace\SetProperty("ScreenUpdating = #True")
    
    ChartSpace\SetProperty("HasChartSpaceTitle = #True") 
    ChartSpace\SetProperty("ChartSpaceTitle\Caption = 'Overview'") 
    ChartSpace\SetProperty("ChartSpaceTitle\Font\Bold = #True") 
    ChartSpace\SetProperty("ChartSpaceTitle\Font\Underline = #True") 
    
    ChartSpace\SetProperty("SeriesCollection\Type = 6") ;6=chChartTypeLine 
    ChartSpace\SetProperty("DataSource = " + Str(ExcelObject) + " As COMateObject") 
    
    myChart = ChartSpace\GetObjectProperty("Charts\Add") 
    
    If myChart 
      
      myChart\SetProperty("Type = 6") ; 6 = chChartTypeLine 
      
      mySeriesCollection = myChart\GetObjectProperty("SeriesCollection\Add") 
      
      If mySeriesCollection 
        
        mySeriesCollection\Invoke("SetData( 0, 0, 'B1')")  ;0 = chDimSeriesNames 
        mySeriesCollection\Invoke("SetData( 1, 0, 'A1:B1')") ;1 = chDimCategories 
        mySeriesCollection\Invoke("SetData( 2, 0, 'A2:B2')") ;2=chDimValues 
      
        mySeriesCollection\Release() 
        
      Else 
        
        Debug "!mySeriesCollection" 
        
      EndIf 
      
      myChart\Release() 
      
    Else 
      
      Debug "!myChart" 
      
    EndIf 
    
  EndIf

  HideWindow(0,0)
  
  If ExcelObject 
    Repeat 
    Until WaitWindowEvent()=#PB_Event_CloseWindow
    ExcelObject\Release()
    ChartSpace\Release()
  EndIf
  CloseWindow(0)
EndIf
Nochmal vielen Dank für deine tolle Hilfe! Natürlich geht der Dank auch ts-Soft :-)

Verfasst: 30.01.2009 15:28
von Kiffi
noch n paar Anmerkungen:

* Wirf das ExcelObject1 komplett raus. Du erzeugst momentan 2 Charts auf Deinem Fenster. // edit: haste schon selber bemerkt? ;-)

* Die Zeile

Code: Alles auswählen

If ExcelObject
ziehst Du nach oben direkt unter CreateActiveXControl

* ChartSpace muss natürlich auch released werden, wenn Du die
Event-Schleife verlässt.

Grüße ... Kiffi

Verfasst: 30.01.2009 15:59
von CNESM
Jab, habs schon selbst gemerkt. Das passiert leider beim einfachen Kopieren schon mal :)

Auch die restlichen Dinge habe ich noch eingebaut! Danke !!
Alle Zeiten sind UTC+02:00
Seite 5 von 5

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de