PureBoard

Verfasst: **23.05.2007 20:37**

Hallole Ihr,
ich habe folgendes vor.

In einem vorhandenem Excelblatt ( nur 1 Arbeitsseite ) will ich bestimmte Zahlenwerte in einen Spaltenbereich ( z.B. G12:G40 ) reinschreiben.
Danach soll mit Excel die Spalte weiter bearbeitet werden ( Summe der Spalte ).
Die Beispiele hier beziehen sich ja mit dem Auslesen "aus" einer Exceldatei, ich will es aber gerade umgekehrt machen.
Hat da einer eine Idee wie man das Problem angehen kann.

Vielen Dank schon mal für die Infos.

Verfasst: **23.05.2007 20:43**

PureDisphelper findeste auf PureArea.net im Showcase, beispiele sind bei,
ansonsten kannste hier mal gucken: http://www.purebasic.fr/german/viewtopi ... 953#149953

Verfasst: **23.05.2007 23:10**

Hallo ts-soft,
danke erst mal.
Das sind ja eine Unmenge von Codes in den verschiedenen Foren. Ist schon zu viel für mich als Anfänger. Kannst du mit bitte sagen, welches der letzte Stand ist, und welche Dateien ich in einen Ordner packen muss ( inkl. der Exceldatei ) damit das so funktioniert wie ich es oben beschrieben habe? Das Anpassen mit den Spalten werde ich dann wohl schon hinbekommen, wenn ich mal ein funktionierendes Beispiel vor mir habe.

Habe PureBasic v4.02 (Windows - x86) im noch jungfräulichem Zustand.

Das heisst so wie ich es installiert habe, ohne Einbindungen von Userlibs usw.
Muss ich da evtl. auch noch Ängerungen in den PureBasic Ordnern vornehmen?

Verfasst: **23.05.2007 23:19**

Einfach das Archiv entpacken, es entsteht ein Ordner PureBasic, den
kopierste über Deine PureBasic Installation, das ist alles, Beispiele befinden
sich dann im Examples-Ordner von PB und sollten ohne Anpassungen
ausführbar sein.

Speziell zu Excel kann ich Dir aber nicht weiterhelfen, ich nutze es nicht, bzw.
habs nicht installiert, kann also weder was nachlesen noch testen.

Verfasst: **24.05.2007 11:17**

HemSA hat geschrieben: In einem vorhandenem Excelblatt ( nur 1 Arbeitsseite ) will ich bestimmte Zahlenwerte in einen Spaltenbereich ( z.B. G12:G40 ) reinschreiben.

schic hat in folgendem Beispiel-Code sehr schön demonstriert, wie man Excel-Dateien (auch ohne User Libraries

) mit COM-Objekten auslesen kann:
http://www.purebasic.fr/german/viewtopi ... 72&start=5

In folgendem Beitrag hat er noch weitere nützliche Prozeduren veröffentlicht, u.a. wie man Werte in Zellen eines Excel-Tabellenblattes schreibt:
http://www.purebasic.fr/german/viewtopi ... 4&start=20

Wenn man dies kombiniert und entsprechend anpaßt, kommt dieser Beispiel-Code heraus, der die Datei "Test.xls" (muß bereits vorhanden sein!) im Temp-Verzeichnis des jeweiligen Windows-Systems öffnet und - wie gewünscht - in den Bereich G12:G40 Werte einträgt. Es erfolgt dann sicherheitshalber noch die Abfrage, ob die veränderte Tabelle wirklich gespeichert werden soll. Das Beispiel läuft auch in einem neu installierten PB 4.02 ohne jegliche User Library

Code: Alles auswählen

#CRLF = Chr(13) + Chr(10)

;{- COM Constants 
#CLSCTX_INPROC_SERVER  = $1 
#CLSCTX_INPROC_HANDLER = $2 
#CLSCTX_LOCAL_SERVER   = $4 
#CLSCTX_REMOTE_SERVER  = $10 
#CLSCTX_ALL = (#CLSCTX_INPROC_SERVER|#CLSCTX_INPROC_HANDLER|#CLSCTX_LOCAL_SERVER|#CLSCTX_REMOTE_SERVER) 

#DISPID_PROPERTYPUT = -3 

#DISPATCH_METHOD          = 1 
#DISPATCH_PROPERTYGET     = 2 
#DISPATCH_PROPERTYPUT     = 4 
#DISPATCH_PROPERTYPUTREF  = 8 
;} 

;{- Structures
Structure EXCEPINFO 
  wCode.w; 
  wReserved.w; 
  bstrSource.s; 
  bstrDescription.s; 
  bstrHelpFile.s; 
  dwHelpContext.l; 
  pvReserved.l ; 
  pfnDeferredFillIn.l 
  scode.l ; 
EndStructure 

Structure SAFEARRAYBOUND 
  cElements.l ;ULONG 
  lLbound.l ;LONG 
EndStructure 

Structure ObjType 
  lpObj.l 
  strObjNam.s 
EndStructure 
;} 

;{- COM Globals 
;Global pApp.IDispatch 
Global pvResult.VARIANT 
Global IID_NULL.GUID 
Global LastError.l 
Global LastMessage.s 
;} 

;{- COM Arrays Linked Lists 
Global Dim varArr.VARIANT(0) 
Global NewList ObjectList.ObjType() 
;} 

Procedure.l Ansi2Uni(ansistr) ; Converts normal (Ansi) string to Unicode 
  ;lenA.l = Len(ansistr) 
  lenA.l = MemoryStringLength(ansistr, #PB_Ascii) 
  
  lenW = MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, 0, 0);#CP_ACP 
  If (lenW > 0) ; Check whether conversion was successful 
    unicodestr = SysAllocStringLen_(0, lenW) 
    result = MultiByteToWideChar_(#CP_ACP, 0, ansistr, lenA, unicodestr, lenW);#CP_ACP 
    If result = 0 
      Debug "Ansi2Uni(ansistr): " + Hex(result) 
      ProcedureReturn 0 
    EndIf 
    ProcedureReturn unicodestr 
  Else 
    ProcedureReturn 0 
  EndIf 
EndProcedure 

Procedure.s Uni2Ansi(unicodestr.l) ; Converts Unicode to normal (Ansi) string 
  lenA = WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, 0, 0, 0, 0); 
  ansistr.s = Space(lenA) 
  If (lenA > 0) 
    WideCharToMultiByte_(#CP_ACP, 0, unicodestr, -1, @ansistr, lenA, 0, 0); 
  EndIf 
  ProcedureReturn ansistr 
EndProcedure 

Procedure.l AutoWrap(autoTyp.l, *pDisp.IDispatch, name.s, nArgs.l) 
  dispID.l 
  Exception.EXCEPINFO 
  
  dp.DISPPARAMS 
  dispidNamed = #DISPID_PROPERTYPUT 
  
  ;Convert to Uni 
  ptUniName = Ansi2Uni(@name) 
  ;Get DISPID for name passed... 
  ;Debug "trying name: " + name 
  hr = *pDisp\GetIDsOfNames(IID_NULL, @ptUniName, 1, #LOCALE_USER_DEFAULT, @dispID) 
  
  ;Build DISPPARAMS 
  dp\cArgs  = nArgs 
  dp\rgvarg = @varArr(0) ;ArgsArr;pArgs;*var; 
  
  ;Handle special-case for property-puts! 
  If autoTyp & #DISPATCH_PROPERTYPUT 
    dp\cNamedArgs = 1 
    dp\rgdispidNamedArgs = @dispidNamed 
  EndIf 
  
  ;Make the call! 
  hr = *pDisp\Invoke(dispID, IID_NULL, #LOCALE_USER_DEFAULT, autoTyp, @dp, @pvResult, @Exception, #Null);#LOCALE_SYSTEM_DEFAULT 
  If hr <> #S_OK 
    Debug "error " + Str(hr) + " with name: " +  name 
    LastError = hr 
  EndIf 
  Select hr 
    Case #DISP_E_EXCEPTION 
      MessageRequester(Uni2Ansi(@Exception\bstrSource), Uni2Ansi(@Exception\bstrDescription) + #CRLF + "Fehler Nr. " + Hex(hr) + " mit Objekt/Eigenschaft " + name, #MB_ICONERROR) 
      Debug Uni2Ansi(@Exception\bstrSource) 
      Debug "an Error occured in Excel " + Uni2Ansi(@Exception\bstrDescription) 
    Case #S_OK 
      
    Default 
      MessageRequester("Excel Fehlermeldung", "Fehler Nr. " + Hex(hr) + " mit Objekt/Eigenschaft " + name, #MB_ICONERROR) 
      Debug "Fehler Nr. " + Hex(hr) + " mit Objekt/Eigenschaft " + name 
  EndSelect 
;   FreeMemory(ArgsArr) 
  ProcedureReturn hr 
EndProcedure 

Procedure.l SetAppObj(app.s) 
  
  LastError = 0 
  LastMessage = "" 
  
  hr = CoInitialize_(0) 
  If  hr <> #S_OK And hr <> #S_FALSE 
    LastError = hr 
    LastMessage = "Error CoInitialize: ErrorCode " + Hex(hr) 
    End 
  EndIf 
  
  clsid.GUID 
  hr = CLSIDFromProgID_(Ansi2Uni(@app), @clsid) 
  If hr <> #S_OK 
    LastError = hr 
    LastMessage = "Error CLSIDFromProgID: ErrorCode " + Hex(hr) 
    ProcedureReturn 0 
  EndIf 
  
  pCf.IClassFactory 
  
  IID_IClassFactory.GUID 
  IID_IClassFactory\Data1 = $1 
  IID_IClassFactory\Data4[0] = $C0 
  IID_IClassFactory\Data4[7] = $46 
  
  hr = CoGetClassObject_(@clsid, #CLSCTX_LOCAL_SERVER | #CLSCTX_INPROC_SERVER, #Null, @IID_IClassFactory, @pCf) 
  If hr <> #S_OK 
    LastError = hr 
    LastMessage = "Error CoGetClassObject: ErrorCode " + Hex(hr) 
    ProcedureReturn 0 
  EndIf 
  
  
  riid.GUID 
  riid\Data1 = $20400 
  riid\Data4[0] = $C0 
  riid\Data4[7] = $46 
  
  hr = pCf\CreateInstance(#Null, @riid, @*pApp.IDispatch) 
  pCf\Release() 
  If hr <> #S_OK 
    LastError = hr 
    LastMessage = "Error CreateInstance: ErrorCode " + Hex(hr) 
    ProcedureReturn 0 
  Else 
    AddElement(ObjectList()) 
    ObjectList()\lpObj = *pApp 
    ObjectList()\strObjNam = app 
    ProcedureReturn *pApp 
  EndIf 
  
EndProcedure 

Procedure.l SetComObj(lpParentObj, strObjectNam.s, lArgs.l) 
  
  pvResult.VARIANT 
  VariantInit_(@pvResult); 
  hr = AutoWrap(#DISPATCH_PROPERTYGET, lpParentObj, strObjectNam, lArgs) 
  If hr = #S_OK 
    ; Debug strObjectNam + " o.k." 
    AddElement(ObjectList()) 
    ObjectList()\lpObj = pvResult\pdispVal 
    ObjectList()\strObjNam = strObjectNam 
    ProcedureReturn pvResult\pdispVal 
  Else 
    ; Debug strObjectNam + " NOT o.k." 
    LastError = hr 
    LastMessage = "Error Get Object: ErrorCode " + Hex(hr) 
    ProcedureReturn 0 
  EndIf 
  
EndProcedure 

Procedure SetObjNothing(*Object.IDispatch) 
  If *Object 
    *Object\Release() 
  EndIf 
EndProcedure 

Procedure ReleaseAllObjects() 
  i = CountList(ObjectList()) 
  While i >= 0 ;ObjectList() 
    SelectElement(ObjectList(), i) 
    ; Debug "releasing " + ObjectList()\strObjNam 
    ; Debug ObjectList()\lpObj 
    If ObjectList()\lpObj 
      *tmpObj.IDispatch = ObjectList()\lpObj 
      *tmpObj\Release() 
    EndIf 
    i-1 
  Wend 
  ClearList(ObjectList()) 
EndProcedure 

Procedure XLPutCellsStrValue(*sheet.IDispatch, Row, Column, strTxt.s) 
  Dim varArr.VARIANT(2) ;init the arguments to get the object Cells 
  varArr(0)\vt = #VT_I4 ;Type of a 4-byte integer for Column 
  varArr(0)\lVal = Column 
  varArr(1)\vt = #VT_I4 ;Type of a 4-byte integer for Row 
  varArr(1)\lVal = Row 
  
  pvResult.VARIANT ;init the return-Variable for AutoWrap 
  VariantInit_(@pvResult); 
  hr = AutoWrap(#DISPATCH_PROPERTYGET, *sheet, "Cells", 2); sheet is the parent Object 
                                                          ; -> we need the Cells-Object 
                                                          ; and get it with 2 arguments 
                                                          ; Column and Row 
                                                          ; Set pXlCells_x_y = *sheet.Cells(Row, Column) 
  pXlCells_x_y.IDispatch = pvResult\pdispVal ; the return-value is a pointer to the object. 
                                             ; The pointer is in pdispVal. This object is 
                                             ; known only to implement IDispatch. 
  Dim varArr.VARIANT(1) ;init the argument to put the property Value 
  varArr(0)\vt = #VT_BSTR
  varArr(0)\bstrVal = Ansi2Uni(@strTxt)
  AutoWrap(#DISPATCH_PROPERTYPUT,  pXlCells_x_y, "Value", 1); putting the property Value (strTxt) to the cells-object 
                                                            ; -> pXlCells_x_y.Value = strTxt 
  VariantClear_(varArr(0)) ; free varArr() 
  
  SetObjNothing(pXlCells_x_y) ; release it at once, to save memory cause we may not need this cells-object any more 
EndProcedure 

;{-Main 
  File$ = GetTemporaryDirectory() + "Test.xls"

  pXlApp.IDispatch = SetAppObj("Excel.Application")
  If pXlApp = 0
    End
  EndIf

  Dim varArr.VARIANT(1) 
  varArr(0)\vt = #VT_I4 
  varArr(0)\lVal = 1
  AutoWrap(#DISPATCH_PROPERTYPUT, pXlApp, "Visible", 1) 
  VariantClear_(varArr(0)) 
  
  pXlBooks.IDispatch = SetComObj(pXlApp, "Workbooks", 0) 
  
  varArr(0)\vt = #VT_BSTR 
  varArr(0)\lVal = Ansi2Uni(@File$) 
  AutoWrap(#DISPATCH_METHOD, pXlBooks, "Open", 1) 
  VariantClear_(varArr(0)) 
  
  pXlBook.IDispatch = SetComObj(pXlApp, "ActiveWorkbook", 0) 
  
  pXlSheets.IDispatch = SetComObj(pXlBook, "Worksheets", 0) 
  
  Dim pXlSheet.IDispatch(1) 

  Dim varArr.VARIANT(1) 
  varArr(0)\vt = #VT_I4 
  varArr(0)\lVal = 1 
  pXlSheet(1) = SetComObj(pXlApp, "Worksheets", 1) 
  VariantClear_(varArr(0)) 
    
  For i = 12 To 40
    XLPutCellsStrValue(pXlSheet(1), i, 7, "G" + Str(i))
  Next i

  AutoWrap(#DISPATCH_METHOD, pXlApp, "Quit", 0) 
  ReleaseAllObjects() 
  CoUninitialize_() 
  LastError = 0 
  ;}

Verfasst: **24.05.2007 16:48**

>> Das Beispiel läuft auch in einem neu installierten PB 4.02 ohne jegliche User Library

Aber nur im ASCII-Modus, zumindest die beiden Ansi2Uni und Uni2Ansi sollte
man doch den bedürfnissen von PB 4 anpassen.

PueDisphelper ist ja auch als Include mit mehr Funktionalität enthalten und
wesentlich Einsteigerfreundlicher. Der obige Source hat aber den Vorteil,
er ist schneller, aber wenn man den für PB4 anpreist, sollte man den auch
anpassen , so ist es ein eingeschränkt unter PB4 laufender PB3.94 Code

Verfasst: **24.05.2007 17:31**

ts-soft hat geschrieben: PueDisphelper ist ja auch als Include mit mehr Funktionalität enthalten und wesentlich Einsteigerfreundlicher.

"mehr Funktionalität": ja, unbestritten
"wesentlich Einsteigerfreundlicher": warum schreibt dann HemSA folgendes?

HemSA hat geschrieben: Das sind ja eine Unmenge von Codes in den verschiedenen Foren. Ist schon zu viel für mich als Anfänger. Kannst du mit bitte sagen, welches der letzte Stand ist, und welche Dateien ich in einen Ordner packen muss ( inkl. der Exceldatei ) damit das so funktioniert wie ich es oben beschrieben habe?

Mein Beispiel funktioniert einfach mit Copy und Paste problemlos in PB 4 gemäß meiner kurzen Anleitung (zugegebenermaßen nur im ANSI-Modus, aber der ist voreingestellt und dürfte von Anfängern auch genutzt werden).

Verfasst: **24.05.2007 18:27**

>> warum schreibt dann HemSA folgendes?
Das weiß ich nicht, er sollte nur das Paket von PureArea downloaden, nicht
die Foren durchsuchen. Für fast alles sind sofort lauffähige Beispiele bei.

Verfasst: **24.05.2007 19:38**

ts-soft:
ich habe es so gemacht wie du es mir erklärt hast. Dann habe ich die
excel.pb von den Beispielen gestartet - sieht kurz und "übersichtlich" aus

, aber ich bekam dann die folgende Fehlermeldung:
"Couldn't create Excel-Object"

Code: Alles auswählen

; example by Kiffi

EnableExplicit

Define.l ExcelApp, Workbook

dhToggleExceptions(#True)

ExcelApp = dhCreateObject("Excel.Application")

If ExcelApp

  dhPutValue(ExcelApp, ".Visible = %b", #True)

  dhGetValue("%o", @Workbook, ExcelApp, ".Workbooks.Add")

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 1, @"Feel")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 2, 1, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 3, 1, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 4, 1, @"Power")

  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 2, @"the")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 3, @"pure")
  dhPutValue(ExcelApp, "Cells(%d, %d).Value = %s", 1, 4, @"Power")

  MessageRequester("PureDispHelper-ExcelDemo", "Click OK to close Excel")

  dhCallMethod(ExcelApp, ".Quit")

  dhReleaseObject(Workbook) : Workbook = 0
  dhReleaseObject(ExcelApp) : ExcelApp = 0

Else

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

EndIf

Shardik: Habe deinen Code genau übernommen. Das Programm gestartet, es hat sich dann ohne Fehlermeldung gleich wieder verabschiedet und sich beendet. Ohne die von dir beschriebenen Sicherheitsabfrage ob die veränderte Tabelle wirklich gespeichert werden soll.

Ich habe dann folgendes geändert am Code:

Code: Alles auswählen

;File$ = GetTemporaryDirectory() + "Test.xls" 
  File$="c:\test.xls"

und eine Exceldatei mit dem Namen direkt in das Verzeichnis c:\test.xls gespeichert. Aber mit offenem oder geschlossenem Excel hat sich in der Datei test.xls nichts getan.

Was mache ich falsch?

Verfasst: **24.05.2007 20:00**

>> "Couldn't create Excel-Object"
Die Meldung erhalte ich auch, hab ja auch kein MS-Office installiert. Solltest
mal überprüfen ob Du MS-Excel überhaupt installiert hast.
Für openCalc sind auch Beispiele bei!

PureBoard

Werte in einen bestimmten Bereich einer Excelseite schreiben

Werte in einen bestimmten Bereich einer Excelseite schreiben