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
