Zum Testen bitte einfach in Zeile 60 eine beliebige DBF einsetzen, wird nicht geändert.
Code: Alles auswählen
#include "Xbp.ch"
#include "Appevent.ch"
#include "Gra.ch"
#pragma Library( "ascom10.lib" )
PROCEDURE Appsys
RETURN
PROCEDURE Main
LOCAL nEvent, mp1, mp2, oXbp
LOCAL oDlg
LOCAL oDraw
oDlg := XbpDialog():new( AppDesktop(),,, {200, 100} )
oDlg:tasklist := .T.
oDlg:titlebar := .T.
oDlg:title := "Excel-Test"
oDlg:create():Show()
centerControl(oDlg)
oDraw := oDlg:drawingArea
oDraw:SetcolorBG(GRA_CLR_YELLOW)
oXbp := XbpPushbutton():new(oDraw,, {50, 10}, {80, 30})
oXbp:caption := "Excel-Test"
oXbp:activate := {||excel()}
oXbp:create()
nEvent := 0
DO WHILE nEvent <> xbeP_Close
nEvent := AppEvent( @mp1, @mp2, @oXbp )
oXbp:handleEvent( nEvent, mp1, mp2 )
ENDDO
RETURN
function Excel()
local nLine := 2, i, oExcel, oWorkbook, oSheet, nFelder, bAlterFehlerblock := ErrorBlock()
oExcel := CreateObject( "Excel.Application" )
IF Empty( oExcel )
ConfirmBox(, "MS-Excel scheint nicht oder nicht korrekt installiert zu sein!" + chr(13) + "Fehlernr.: " + ltrim(str(ComLastError())) +;
" Fehler: " + ComLastMessage(), , XBPMB_OK, XBPMB_CRITICAL)
return .f.
ENDIF
ErrorBlock({|oError|Excelfehler(oError)})
begin sequence
oExcel:Application:DisplayAlerts := .F.
oExcel:Application:Workbooks:new()
oExcel:visible := .T. // i want to see something
oWorkbook = oExcel:Workbooks:Add() //oWorkbook besser zum Suchen
oSheet := oWorkbook:Worksheets(1) //Referenz auf das 1. Worksheet
select 0
use ("d:\prg\xpp\adresse.dbf") SHARED
if Neterr()
break()
endif
oExcel:Application:Worksheets(1):name:='Adressen'
go top
nFelder := fcount()
for i := 1 to nFelder
oSheet:cells(1, i):Value := fieldname(i)
next i
oSheet:RANGE('1:1'):Font:Bold := .T.
oSheet:Range( "1:1" ):Interior:ColorIndex := 15
do while .not. eof()
for i := 1 to nFelder
oSheet:cells(nLine, i):Value := fieldget(i)
next i
nLine++
skip
enddo
dbclosearea()
//oExcel:application:workbooks(1):saveas(cFile)
//oExcel:Application:Quit()
//oExcel:Quit()
end sequence
ErrorBlock(bAlterFehlerblock)
return .t.
function excelfehler(oError)
confirmbox(,"In Excel ist folgender Fehler aufgetreten: " + oError:description + " Bei Ausführung von: " +;
oError:operation)
break()
return NIL