*****************************************
** Nazwa: EXCEL_MAKER.PRG
** Przeznaczenie: tworzenie pliku excellowego
** All Copyright reserved
** Autor: Dawid.Federowicz@gmail.com
** Wersja: 1
*****************************************
*****************************************
** UWAGI:
** Program działa na kompie, na którym jest zainstalowane Visual FoxPro 6.0.
**
** INTRUKCJA:
** Program należy zgrać do katalogu, w którym s± pliki DBF.
** Program odszukuje pliki DBF i każdy z nich wrzuca do osobnej zakładki Excela.
** Następnie cały dokument zapisywany jest pod nazwą określoną przez Użytkownika.
**
** OGRANICZENIA:
** Niestety, jest tutaj również ograniczenie co do ilo¶ci rekordów, jakie mog± być zapisane do pliku excelowego.
** "Wysłać" do Excella można tylko nieco ponad 16 tysięcy linii - i takie też ograniczenie jest w poniższym kodzie.
** W kolejnej wersji programu postaram się przeskoczyć ten problem... Je¶li komu¶ się to udało - byłbym wdzięczny za informację!
*****************************************
 
CLOSE DATA ALL
CLEAR
 
** Komunikaty...
mess_wybierz_localization = 'Gdzie zapisać raport?'
mess_wybierz = 'Podaj nazwę pliku, pod jak± ma być zapisany plik wynikowy'
mess_brak_plikow = 'W katalogu nie znaleziono plików DBF. Operacja anulowana'
mess_koniec = 'Zakończone! Dane zostały wstawione do Excella. Have a nice...!'
mess_powered = 'Powered by Dawid.Federowicz@gmail.com'
mess_end_ok = 'OK'
mess_end_bad = 'Zakończone z błędem'
 
SET SAFETY OFF
SET DECIMALS TO 0
SET DATE TO DMY
gcdire=SYS(5)+CURDIR()
SET DEFAULT TO (gcdire)
I=(gcdire)
IF(EMPTY(I))
    ** katalog nie zawiera DBF-ów...
    MESSAGEBOX(mess_brak_plikow,48,mess_end_bad)
    QUIT
ELSE
    SET DEFAULT TO (I)
ENDIF
WAIT WINDOW '' TIME 0.1
! DIR *.DBF /S/B > P1.TMP
CREATE CURSOR aaa (PLIKI C(254))
SELECT aaa
APPEND FROM P1.TMP TYPE SDF
DELETE FILE P1.TMP
SELECT COUNT(*) AS ile FROM aaa INTO CURSOR ile_plikow
IF ile_plikow.ile=0
    ** chociaż s± pliki, to nie zawiraj± one rekordów...
    MESSAGEBOX(mess_brak_plikow,48,mess_end_bad)
    CLOSE DATA ALL
    QUIT
ENDIF
WAIT WINDOW mess_wybierz NOWAIT
fl1 = PUTFILE(mess_wybierz_localization,'', 'XLS')
 
SET OLEOBJECT ON
oSheet = GETOBJECT('','excel.sheet') 
oApp = oSheet.APPLICATION 
oApp.VISIBLE = .f. 
oApp.DisplayAlerts = .f.
oBook = oApp.WorkBooks.ADD(1)
oSheet = oApp.ActiveSheet
autor = oBook.writereservedby
 
USE (aaa.pliki) IN 0 ALIAS pierwszy
SELECT pierwszy
USE
nr=0
cnt=0
SELECT aaa
SCAN
    I=aaa.PLIKI
    nr=nr+1
    USE (i) IN 0 ALIAS piatek
    SELECT piatek
    COUNT TO b
    IF b>0 THEN
 	IF nr>1
	    oApp.Sheets.ADD
	ENDIF
	oSheet = oApp.ActiveSheet
	oSheet.NAME = JUSTFNAME(aaa.pliki)
	oSheet.Cells.Select
	oSheet.Cells.FONT.Size = 8
	oSheet.Cells.EntireColumn.AutoFit
	oSheet.Cells.NUMBERFORMAT = "@"
 
	SELECT * FROM piatek INTO ARRAY tabliczka
	SELECT piatek
	ile_wierszy = AFIELDS(tablica)
	FOR start = 1 TO ile_wierszy
	    oSheet.Cells(1,start).VALUE = tablica(start,1)
	ENDFOR
	SELECT COUNT(*) AS ile FROM piatek INTO CURSOR bbb
	FOR i = 1 TO bbb.ile
	    FOR j = 1 TO ile_wierszy
		oSheet.Cells(i+1,j).VALUE = tabliczka(i,j)
	    ENDFOR
	ENDFOR  
	oSheet.Cells.Select
	oSheet.Cells.FONT.Size = 8
	oSheet.Cells.EntireColumn.AutoFit
    ENDIF
    SELECT piatek
    USE
ENDSCAN
 
** wstawiamy stopkę na ostatnim arkuszu
oSheet.Cells.Select
oSheet.Cells.FONT.Size = 8
oSheet.Cells.EntireColumn.AutoFit
oSheet.Cells(bbb.ile+3,1).VALUE = mess_powered
oSheet.Cells(bbb.ile+4,1).VALUE = 'Wykonał: ' + autor
oSheet.Cells(bbb.ile+5,1).NUMBERFORMAT = "@"
oSheet.Cells(bbb.ile+5,1).VALUE = DATETIME()
linia = bbb.ile+3
oSheet.ROWS(linia).FONT.BOLD = .t.
linia = bbb.ile+4
oSheet.ROWS(linia).FONT.BOLD = .t.
linia = bbb.ile+5
oSheet.ROWS(linia).FONT.BOLD = .t.
oApp.ActiveWorkbook.SAVEAS(fl1)
 
** pokazanie skoroszytu, który wypełniali¶my
oApp.VISIBLE = .t. 
CLOSE DATA ALL
QUIT