array2xls / xls2array

Alle Fragen um die Programmierung, die sich sonst nicht kategorisieren lassen. Von Makro bis Codeblock, von IF bis ENDIF

Moderator: Moderatoren

Antworten
peternmb
1000 working lines a day
1000 working lines a day
Beiträge: 525
Registriert: Mi, 01. Feb 2006 16:22
Wohnort: 06618 Naumburg

array2xls / xls2array

Beitrag von peternmb »

Hallo,

ich arbeite daran, mein Programm alternativ englischsprqachig zu machen.
Für die Übersetzungen verwende ich ein Array - nun möchte ich alternativ dabei auch mit Excel arbeiten.
Dazu möchte ich mit 2 kleinen Funtionen mein Array nach Excel übertragen und die Excel-Datei auch wieder als Array speichern können.

Leider hängt es schon am Anfang.
Hier mein Beispielcode, der einen fatalerror erzeugt, vielleicht kann mir jemand weiterhelfen:

Code: Alles auswählen

//
aLG:={}   // Array leeren
aadd(aLG,{100,"Abbruch","Exit"} ) 
aadd(aLG,{101,"sichern","save"} )
aadd(aLG,{102,"drucken","print"} )

a2xls(aLG,"TEST.XLS")
//
//usw.

#include "Xbp.ch"
#include "activex.ch"
#include "excel.ch"
proc a2xls(myArray,xls_datei)
//
LOCAL oExcel, oBook
//
oExcel := CreateObject("Excel.Application")
IF Empty( oExcel )
  MsgBox( "Um diese Funktion zu nutzen muss auf dem Rechner Excel installiert sein!","Problem" )
  RETURN
ELSE
  //MsgBox( "Excel (Version: "+var2char(oExcel:version)+") ist installiert !","Hinweis" )
ENDIF
//
oExcel:DisplayAlerts := .F.
oExcel:visible       := .F.
//
oWorkBooks    := oExcel:Workbooks
oBook         := oWorkbooks:Open( Hauptpfad+"\"+xls_datei  )
oWorkSheet1   := oBook:Sheets( 1 )
//
oRange := oWorkSheet1:Range("A1:"+"C:"+str(len(myArray),4,0))
oRange:Select()
oRange:Value := myArray
//
oBook:SaveAs( Hauptpfad+"\"+xls_datei , xlWorkbookNormal )
//
oExcel:Quit()
oExcel:Destroy()
//
return
Benutzeravatar
Koverhage
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2470
Registriert: Fr, 23. Dez 2005 8:00
Wohnort: Aalen
Hat sich bedankt: 102 Mal
Danksagung erhalten: 3 Mal
Kontaktdaten:

Re: array2xls / xls2array

Beitrag von Koverhage »

oRange := oWorkSheet1:Range("A1:"+"C:"+str(len(myArray),4,0))
Sollte ltrim sein!
Gruß
Klaus
peternmb
1000 working lines a day
1000 working lines a day
Beiträge: 525
Registriert: Mi, 01. Feb 2006 16:22
Wohnort: 06618 Naumburg

Re: array2xls / xls2array

Beitrag von peternmb »

Koverhage hat geschrieben:
oRange := oWorkSheet1:Range("A1:"+"C:"+str(len(myArray),4,0))
Sollte ltrim sein!
Nützt nichts, es kracht bei

Code: Alles auswählen

oRange:Value := MyArray
Benutzeravatar
brandelh
Foren-Moderator
Foren-Moderator
Beiträge: 15689
Registriert: Mo, 23. Jan 2006 20:54
Wohnort: Germersheim
Hat sich bedankt: 65 Mal
Danksagung erhalten: 33 Mal
Kontaktdaten:

Re: array2xls / xls2array

Beitrag von brandelh »

Array fügt man über Zwischenablage ein ... hier meine Exportfunktion einer DBF, bei dir brauchst das Array ja nicht mehr erzeugen, nur in cTxt übersetzen

Code: Alles auswählen

*-------------------------------------------------------------------------------------
function doExportToXLS(oExcel,cXLS)
  LOCAL oBook, oSheet, nCol,nRow, nAltPos
  LOCAL nAnz, nStartRec, nEndeRec, nAnzRec, cTxt, cFName, cZei
  LOCAL aVarToExcel, cType, x, xMax, oClipBoard, nOffsetDataRow, aDateColumns,aTextColumns

  oExcel:visible       := .F.

  set cursor off

  // Feldnamen ermitteln"
  xMax   := FCount()
  // Feldnamen und Codeblock der Umsetzung einmal ermitteln
  cFName := ""
  nOffsetDataRow := 0 // keine automatisch gesetzten linken Spalten
  aDateColumns   := {}
  aTextColumns   := {}
  aVarToExcel    := Array(xMax)
  for x := 1 to xMax
      cFName += upper(fieldname(x))+chr(9)
      cType  := valtype(fieldget(x))
      do case
         case cType="D"
              aVarToExcel[x] := {|dVar|iif(empty(dVar),"",ntrim(D2Excel(dVar)))}
              aadd(aDateColumns,x+nOffsetDataRow)
         case cType="C"
              aVarToExcel[x] := {|cVar|alltrim(cVar)}
              aadd(aTextColumns,x+nOffsetDataRow)
         case cType="M"
              aVarToExcel[x] := {|mVar|Memo2Line(mVar)}
         case cType="N"
              aVarToExcel[x] := {|nVar|strTran(str(nVar),".",",")}
         case cType="L"
              aVarToExcel[x] := {|lVar|iif(lVar,"J","N")}
         // andere führen zum Fehler
      endcase
  next

  nAnzRec   := 50000
  nStartRec := 1
  nEndeRec  := 0

  DbGoTop()

  oBook  := oExcel:workbooks:Add()
  oSheet := oBook:ActiveSheet
  oSheet:delete()
  oSheet := oBook:ActiveSheet
  oSheet:delete()
  oSheet := oBook:ActiveSheet

  // Clipboard-Objekt erzeugen
  oClipBoard := XbpClipBoard():new():create()

  nRow := row()
  nCol := col()+5
  @ nRow,nCol say "Bitte warten ...     %"
  nCol += 17
  nAltPos := 0

  do while ! eof()
     nEndeRec := nStartRec + nAnzRec -1
     // in die erste Zeile kommen die Feldnamen
     cTxt := cFName+CRLF
     // Unten sollen dann die RecNo() stehen
     oSheet:name := ntrim(nStartRec)+" - "+ntrim(min(nEndeRec,lastrec()))
     for nStartRec := nStartRec to nEndeRec
         if eof()
            exit
         endif
         if nAltPos < DbPosition() // gibt ein ruhigeres Bild
            nAltPos := DbPosition()
            @nRow,nCol say nAltPos picture "999"
         endif
         cZei := ""  // keine automatisch gesetzten linken Spalten
         for x := 1 to xMax
             cZei += eval(aVarToExcel[x],fieldget(x))+TAB
         next
         cTxt += cZei + CRLF
         dbskip()
     next

     oClipBoard:Open()
     if ! oClipBoard:Clear()
        msgbox("Zwischenablage konnte nicht gelöscht werden !"+chr(13)+;
               "Das kann zu Problemen beim PASTE führen, notfalls Rechner neu starten","Fehler bei oCB:Clear()")
     endif
     oClipBoard:SetBuffer(cTxt)
     oClipBoard:Close()

     @nRow,nCol+6 say " -> PASTE " color "w+/g"
     aeval(aDateColumns, {|nCol| oSheet:Columns(nCol):NumberFormat := "TT.MM.JJJJ"})
     aeval(aTextColumns, {|nCol| oSheet:Columns(nCol):NumberFormat := "@"})
     oSheet:Cells(1,1):select()
     oSheet:Paste()
     oSheet:Cells(1,1):select()
     @nRow,nCol+6 say space(10)
     oExcel:visible       := .T.
     oSheet:Columns("A:ZZ"):AutoFit()
     oSheet:Rows(1):Font:Bold := .t.
     oExcel:visible       := .F.

     if ! eof()
        oBook:Sheets:Add(,oSheet)
        oSheet := oBook:ActiveSheet
     endif
  enddo

  @nRow,nCol say 100 picture "999"
  oExcel:visible       := .T.
  oBook:SaveAs(cXLS,xlWorkbookNormal)

  /*
     neues Dateiformat von Excel ab 2007 : xlOpenXMLWorkbook
     xlOpenXMLWorkbook  51 Open XML Workbook
  */
  oBook:close()
RETURN NIL
Die Funktion war nötig, weil früher die Zeilenanzahl nicht ausreichte in Excel.
Gruß
Hubert
Benutzeravatar
Koverhage
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2470
Registriert: Fr, 23. Dez 2005 8:00
Wohnort: Aalen
Hat sich bedankt: 102 Mal
Danksagung erhalten: 3 Mal
Kontaktdaten:

Re: array2xls / xls2array

Beitrag von Koverhage »

bei mir ist das so (ist auch schneller)

oSheet:Range("A1:C"+cMaxLength):value := aUmsatz
Gruß
Klaus
Benutzeravatar
Wolfgang Ciriack
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2932
Registriert: Sa, 24. Sep 2005 9:37
Wohnort: Berlin
Hat sich bedankt: 13 Mal
Danksagung erhalten: 34 Mal
Kontaktdaten:

Re: array2xls / xls2array

Beitrag von Wolfgang Ciriack »

Besser wäre es, du postest hier Code, den man kopieren und dann gleich kompilieren kann.
Ein Fehler war die Range: "A1:C:"+..., da darf hinter dem C kein Doppelpunkt sein.
Hier ein funktionierendes Beispiel zum speichern der Array-Daten in eine Exceldatei:

Code: Alles auswählen

#PRAGMA LIBRARY( "ASCOM10.LIB" )
****************************************************************************
PROC appsys ; RETURN
****************************************************************************
FUNCTION Main()
local aLG:={}

aadd(aLG,{100,"Abbruch","Exit"} )
aadd(aLG,{101,"sichern","save"} )
aadd(aLG,{102,"drucken","print"} )

a2xls(aLG,"TEST.XLS")

return Nil
**************************************************************************
proc a2xls(aMyArray,cXls_datei)
LOCAL oExcel, oBook, oWorksheet1
local Hauptpfad:="X:\fvw\diverses\fremd1"

oExcel := CreateObject("Excel.Application")
IF Empty( oExcel )
  MsgBox( "Um diese Funktion zu nutzen muss auf dem Rechner Excel installiert sein!","Problem" )
  RETURN
ENDIF

oExcel:Visible:=.F.
oExcel:DisplayAlerts := .F.

oBook := oExcel:Workbooks:Add()
oWorkSheet1 := oBook:ActiveSheet
oWorkSheet1:Select()
**************
SetExcelValue("A1:"+"C"+alltrim(str(len(aMyArray))), oWorksheet1, aMyArray)
**************
*oBook:SaveAs( Hauptpfad+"\"+xls_datei , xlWorkbookNormal )
oBook:SaveAs( Hauptpfad+"\"+cXls_datei)

oExcel:Quit()
oExcel:Destroy()

return
*********************************************************************
static FUNCTION SetExcelValue(cRange,oWorkSheet,xValue)
LOCAL oRange
oRange := oWorkSheet:Range(cRange)
oRange:Select()
oRange:Value := xValue
oRange := nil
RETURN nil
Viele Grüße
Wolfgang
Benutzeravatar
Wolfgang Ciriack
Der Entwickler von "Deep Thought"
Der Entwickler von "Deep Thought"
Beiträge: 2932
Registriert: Sa, 24. Sep 2005 9:37
Wohnort: Berlin
Hat sich bedankt: 13 Mal
Danksagung erhalten: 34 Mal
Kontaktdaten:

Re: array2xls / xls2array

Beitrag von Wolfgang Ciriack »

Hupps, da waren andere schneller :)
Viele Grüße
Wolfgang
peternmb
1000 working lines a day
1000 working lines a day
Beiträge: 525
Registriert: Mi, 01. Feb 2006 16:22
Wohnort: 06618 Naumburg

Re: array2xls / xls2array

Beitrag von peternmb »

Vielen Dank, so klappt es.
Antworten