PureBoard

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

Auslesen einer Exceltabelle und in eine Textdatei einfügen

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

Seite 1 von 1

Auslesen einer Exceltabelle und in eine Textdatei einfügen

Verfasst: 25.02.2008 22:37
von HemSA
Hallole Ihr,
erst mal vielen Dank an Falko der mit seinem Beispiel mir erst den Code ermöglichte und auch an Kiffi mit seinem Tip gestern.

Mit dem Code kann man Werte aus einer Exceltabelle auslesen, und in eine bestimmte Stelle von einer Textdatei wieder einfügen.

Was den Anfang vom Code angeht, hab ich einfach mal so gelassen wie es im Code von Falko war, da ich nichts mit den Konstanten anfangen kann - sind jetzt bestimmt viele nicht mehr nötig - wenn mir da vielleicht jemand auf die Sprünge helfen kann um was es bei den ganzen Werten am Anfang geht.

Freue mich immer über Kritik. Vielleicht gibt es auch noch was zu verbessern.

Code: Alles auswählen

;EnableExplicit

Define.l Pattern, ExcelAPP, Sheets, SheetN, n, AnfangX, AnfangY, EndeX, EndeY
Define.s StandardFile, sPattern, Datei, StandardFile, Text, endungs.s

#xlAscending = 1
#xlContinuous = 1
#xlCenter = -4108
#xlSolid=1
#xlContinuous=1
#xlThin=2
#xlNone=-4142
#xlWorksheet=-4167
#xlDouble = -4119
#xlDash = -4115
#xlDashDot = 4
#xlDashDotDot = 5
#xlDot = -4118
#xlDouble = -4119
#xlAutomatic = -4105
#xlLineStyleNone = -4142
#xlSlantDashDot = 13
#xlHairline = 1
#xlMedium = -4138
#xlThick = 4
#xlDiagonalDown = 5
#xlDiagonalUp = 6
#xlEdgeBottom = 9
#xlEdgeLeft = 7
#xlEdgeRight = 10
#xlEdgeTop = 8
#xlInsideHorizontal = 12
#xlInsideVertical = 11
#xlFormatFromLeftOrAbove = 0
#xlFormatFromRightOrBelow = 1
#xlToolbar = 1
#xlToolbarButton = 2
#xlToolbarProtectionNone = -4143
#xlTop = -4160
#xlTop10Items = 3
#xlTop10Percent = 5
#xlTopToBottom = 1
#xlToRight = -4161
#xlToLeft = -4159
#xlUp = -4162
#xlDown = -4121
#xlLightUp = 14


#xlPatternAutomatic = -4105
#xlPatternChecker = 9
#xlPatternCrissCross = 16
#xlPatternDown = -4121
#xlPatternGray16 = 17
#xlPatternGray25 = -4124
#xlPatternGray50 = -4125
#xlPatternGray75 = -4126
#xlPatternGray8 = 18
#xlPatternGrid = 15
#xlPatternHorizontal = -4128
#xlPatternLightDown = 13
#xlPatternLightHorizontal = 11
#xlPatternLightUp = 14
#xlPatternLightVertical = 12
#xlPatternLinearGradient = 4000
#xlPatternNone = -4142
#xlPatternRectangularGradient = 4001
#xlPatternSemiGray75 = 10
#xlPatternSolid = 1
#xlPatternUp = -4162
#xlPatternVertical = -4166

XIncludeFile "C:\Program Files\PureBasic - 4.02\PureBasic\Examples\DispHelper_Include\VariantHelper_Include.pb" ; write here your VariantHelper_include.pb - path

Procedure OpenExcelFile(Datei.s)
  Protected *obj
  dhToggleExceptions(#True); Toggles error messages from DispHelper on or off
  *obj  = dhCreateObject("Excel.Application")
  If *obj
    dhCallMethod(*obj, ".Workbooks.Open(%T)", @Datei) ; open ExcelFile
  EndIf
  ProcedureReturn *obj
EndProcedure

Procedure ExcelVisible(*obj,Wert.l)
  If Wert=1
    dhPutValue(*obj, ".Visible = %b", #True) ; Visible Excel
  Else
    dhPutValue(*obj, ".Visible = %b", #False) ; Non visible Excel
  EndIf
EndProcedure


Procedure.s ReadCellS1(*obj, Zeile.l,Spalte.l)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, "Cells(%d, %d).Value",Zeile, Spalte) ; read one value
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure


Procedure.s ReadCellS2(*obj, Zeile.l,Spalte.l)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, "Cells(%d, %d).Value",Zeile, Spalte) ; read one value
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure

Procedure.s ReadCellS3(*obj, Zeile.l,Spalte.l)
  Protected ReturnValue.l, Resume.s
  dhGetValue("%T", @ReturnValue, *obj, "Cells(%d, %d).Value",Zeile, Spalte) ; read one value
  If ReturnValue
    Resume=PeekS(ReturnValue)
    dhFreeString(ReturnValue)
    ProcedureReturn Resume
  EndIf
EndProcedure

Procedure CloseWorkbook(*obj)
  Protected Workbook.l
 
  dhGetValue("%o", @Workbook, *obj, ".ActiveWorkbook")
 
  If Workbook
    dhCallMethod(Workbook, ".Close");                          close Excel Worksheet
    dhReleaseObject(Workbook)
  EndIf
 
EndProcedure

Procedure CloseExcelAll(*obj)
  dhCallMethod(*obj, ".Quit"); Close Excel
  dhReleaseObject(*obj):*obj = 0
EndProcedure



;--  Main Program
Define.l i
Define.s Name, wert1s, wert2s, wert3s,wert4s


Datei ="C:\Objekte\Purebasic - 4.0\Programme - PB4.0\Excel-WinTED\WinTED.xls"


ExcelApp=OpenExcelFile(Datei.s)

If ExcelApp
 
  ExcelVisible(ExcelApp,1) 

  wert1s=ReadCellS1(ExcelApp, 1, 2)
  wert2s=ReadCellS1(ExcelApp, 2, 2)
  wert3s=ReadCellS1(ExcelApp, 3, 2)
  wert4s=ReadCellS1(ExcelApp, 4, 2)
  
  MessageRequester("Read_Cells", wert1s)
  MessageRequester("Read_Cells", wert2s)
  MessageRequester("Read_Cells", wert3s)
  MessageRequester("Read_Cells", wert4s)
  
  
  CloseWorkbook(ExcelApp); for changing another table, close this table.
  ExcelVisible(ExcelApp,1)
  CloseExcelAll(ExcelApp); for end of Excel
 
 
  

Else
   MessageRequester("PureDispHelper-ExcelDemo", "Couldn't create Excel-Object")
EndIf


zeilel.l=0


If OpenFile(1,"C:\Objekte\Purebasic - 4.0\Programme - PB4.0\Excel-WinTED\GAS.TAB") 
    
        
    While Eof(1) = 0 ; sich wiederholende Schleife bis das Ende der Datei ("end of file") erreicht ist
       
                     
       zeilensatzs.s=ReadString(1) 
       zeilel.l=zeilel.l+1                            ;gibt die Zeile an in der der Suchbegriff steht
       
       gastabs.s=Left(zeilensatzs.s,10)               ;beim Suchmodus wird vorausgesetzt, dass
                                                      ;der Suchbegriff am Anfang der Zeile steht
       
       
       If gastabs.s=wert1s
       
       
       gastabwert1s.s=Mid(zeilensatzs.s,176, 5)       ;zum Auslesen von den Werten im Satz ab einer
       gastabwert2s.s=Mid(zeilensatzs.s,181, 5)       ;bestimmten Position mit einer bestimmten Länge
       gastabwert3s.s=Mid(zeilensatzs.s,186, 5)
     
     
     
     
        zeiles.s=Str(zeilel.l) 
     
        MessageRequester("Zeile", zeiles.s)             ; anzeigen vom alten Wert. Nach dem 2. Starten
        MessageRequester("GASTAB-Wert", gastabs.s)      ; wird der neue Wert angezeigt. Hatte es
        MessageRequester("GASTAB-Wert", gastabwert1s.s) ; zur Kontrolle gemacht.
        MessageRequester("GASTAB-Wert", gastabwert2s.s) 
        MessageRequester("GASTAB-Wert", gastabwert3s.s)   
    
    
        FileSeek(1,(zeilel.l-1)*247+175)  ;247 = Zeilenlänge von der Textdatei + 2
        WriteString(1, wert2s)
        
        FileSeek(1,(zeilel.l-1)*247+180)  ;zeile-1 ==> damit der Zeiger am Anfang von der Suchzeile steht 
        WriteString(1, wert3s)

        FileSeek(1,(zeilel.l-1)*247+185)
        WriteString(1, wert4s)            ;schreibt den String ab einer bestimmten Position in die Zeile
        
      EndIf
    
  
    Wend
 
 
Else
    MessageRequester("Information","Konnte Datei nicht öffnen!")
  EndIf


  CloseFile(1) 

End
Ansonsten hoffe ich das es jemand gebrauchen kann.

Re: Auslesen einer Exceltabelle und in eine Textdatei einfüg

Verfasst: 26.02.2008 00:23
von Kiffi
Hallo HemSA,
HemSA hat geschrieben:Ansonsten hoffe ich das es jemand gebrauchen kann.
Dein Code ist sehr speziell auf Deine Bedürfnisse und Deine Daten
angepasst. So speziell, dass ihn wohl niemand hier ohne umfangreiche
Änderungen verwenden kann.

Grüße ... Kiffi
Alle Zeiten sind UTC+02:00
Seite 1 von 1

Powered by phpBB® Forum Software © phpBB Limited

Deutsche Übersetzung durch phpBB.de