#include "Fivewin.ch"
#include "Image.ch"
#include "Fileio.ch"
#include "Colors.ch"
#define TAB Chr(9)
#DEFINE xlLeft -4131 // (0xhffffefdd)
#DEFINE xlRight -4152 // (0xhffffefc8)
#DEFINE xlCenter -4108 // (0xhffffeff4)
#DEFINE xlWorkbookNormal -4143 // (0xhffffefd1)
#DEFINE F_HEADER 1
#DEFINE F_LEN 2
#DEFINE F_FMT 3
#DEFINE F_JUSTIFY 4
FUNCTION MAIN()
LOCAL oDlg, hDC, oClp, oBtn1, oBtn2, oBtn3, oBtn4, oBtn10, aGrad
REQUEST DBFCDX
RddSetDefault("DBFCDX")
SET _3DLOOK ON
SetBalloon( .T. )
DBSELECTAREA(1)
USE Customer ALIAS Test
ORDCREATE( ,"EXPORT","Last", ;
{|| Last } , .F. )
// First C 20
// Last C 20
// Street C 30
// City C 30
// State C 2
// Zip C 10
// Hiredate D 8
// Married L 1
// Age N 2
// Salary N 9.2
// Notes C 70
PRIVATE oButtFont := TFont():New("Arial",0,-16,.F.,.T.,0,0,0,.T. )
DEFINE DIALOG oDlg SIZE 700, 550 TITLE "EXEL => VBA" PIXEL
aGrad := { { 0,50, 3655259, 16777215 }, { 0,50, 16777215, 3655259 } }
DEFINE CLIPBOARD oClp OF oDlg
@ 20, 250 BTNBMP oBtn1 SIZE 80, 30 OF oDlg 2007 ;
FILENAME "Textedit.bmp" ;
LEFT ;
PROMPT " Lesson &1 " ;
FONT oButtFont ;
ACTION ( LESSON1(oDlg,oClp) )
oBtn1:lTransparent = .t.
oBtn1:cTooltip := { "Lesson 1" + CRLF + ;
"learning VBA","Excel", 1, CLR_BLACK, 14089979 }
@ 70, 250 BTNBMP oBtn2 SIZE 80, 30 OF oDlg 2007 ;
FILENAME "Textedit.bmp" ;
LEFT ;
PROMPT " Lesson &2 " ;
FONT oButtFont ;
ACTION ( LESSON1(oDlg,oClp) )
oBtn2:lTransparent = .t.
oBtn2:cTooltip := { "Lesson 2" + CRLF + ;
"learning VBA","Excel", 1, CLR_BLACK, 14089979 }
@ 120, 250 BTNBMP oBtn3 SIZE 80, 30 OF oDlg 2007 ;
FILENAME "Textedit.bmp" ;
LEFT ;
PROMPT " Lesson &3 " ;
FONT oButtFont ;
ACTION ( LESSON1() )
oBtn3:lTransparent = .t.
oBtn3:cTooltip := { "Lesson 3" + CRLF + ;
"learning VBA","Excel", 1, CLR_BLACK, 14089979 }
@ 170, 250 BTNBMP oBtn4 SIZE 80, 30 OF oDlg 2007 ;
FILENAME "Textedit.bmp" ;
LEFT ;
PROMPT " Lesson &4 " ;
FONT oButtFont ;
ACTION ( LESSON1() )
oBtn4:lTransparent = .t.
oBtn4:cTooltip := { "Lesson 4" + CRLF + ;
"learning VBA","Excel", 1, CLR_BLACK, 14089979 }
@ 230, 250 BTNBMP oBtn10 SIZE 80, 30 OF oDlg 2007 ;
FILENAME "Exit.bmp" ;
LEFT ;
PROMPT " &Exit " ;
FONT oButtFont ;
ACTION ( oDlg:End() )
oBtn10:lTransparent = .t.
oBtn10:cTooltip := { "Lesson 1" + CRLF + ;
"learning VBA","Excel", 1, CLR_BLACK, 14089979 }
ACTIVATE DIALOG oDlg CENTER ;
ON PAINT ( GradientFill( hDC, 0, 0, oDlg:nHeight, oDlg:nWidth, aGrad, .T. ), D_ALPHA( hDC ) ) ;
VALID MsgYesNo( "Want to exit ?" )
CLOSE DATABASE
RETURN NIL
// ----------------------------
FUNCTION D_ALPHA( hDC )
LOCAL oBmp1
cALPHA1 := "EXCEL.BMP"
DEFINE BITMAP oBmp1 FILENAME "&cALPHA1"
ABPaint( hDC, 5, 5, oBmp1:hBitmap, 220 )
oBmp1:End()
RETURN NIL
// -------------------------
FUNCTION LESSON1(oDlg, oClp)
LOCAL oMeter, oText, lEnd, nTotal
cFile1 := "Lesson1"
DBSELECTAREA(1)
nTotal := RECCOUNT()
DBGOTOP()
cCustName := (1)->Last
MsgMeter( { | oMeter, oText, oDlg, lEnd | ;
LESSON1a( oMeter, nTOTAL, oText, @lEnd, oClp ) }, ;
"Name : " + cCustName + CRLF + " " , ;
"create Excel Table..." )
// CLIPBOARD - Clear
//---------------------------
oClp:Clear()
MEMORY( -1 )
RETURN( NIL )
// --------------------------
FUNCTION LESSON1a( oMeter, nTOTAL, oText, lEnd, oClp )
LOCAL oSelection, oWin, oExcel, oWorkBook, oSheet
LOCAL cRange := ""
LOCAL nSheets := 0
LOCAL n := 0
LOCAL nRow := 0
LOCAL nHeaderRow := 1 // Line-No. Headline
LOCAL nDataStart := nHeaderRow + 1 // Line-No. Begin of Data
// Define Cell-Format and Size
// ----------------------------------------
LOCAL aFormat := { { "First", 20, "@", xlLeft },;
{ "Last", 20, "@", xlLeft },;
{ "State", 10, "@", xlLeft },;
{ "Zip", 15, "@", xlLeft },;
{ "City", 30, "@", xlLeft },;
{ "Street", 30, "@", xlLeft },;
{ "Hiredate", 10, "TT.MM.JJJJ", xlCenter },;
{ "Married", 10, "@", xlCenter },;
{ "Age", 10, '0', xlRight },;
{ "Salary", 11.2, "#.##0,00", xlRight },;
{ "Notes", 50, "@", xlLeft } }
oExcel := TOleAuto():New( "Excel.Application" )
oWorkBook := oExcel:WorkBooks:Add()
nSheets := oExcel:Sheets:Count()
FOR n := 1 to nSheets - 1
oExcel:Worksheets( n ):Delete()
NEXT
oExcel:Set( "DisplayAlerts", .f. )
oSheet := oExcel:Get( "ActiveSheet" )
oWin := oExcel:Get( "ActiveWindow" )
oSheet:Name := "Customer-List"
oSheet:Cells( nDataStart, 1 ):Select()
oWin:Set( "FreezePanes", .t. )
oSheet:Cells:Font:Size := 10
oSheet:Cells:Font:Name := "Arial"
FOR n := 1 to len( aFormat )
oSheet:Cells( nHeaderRow, n ):Font:Size := 10
oSheet:Cells( nHeaderRow, n ):Font:Bold := .t.
oSheet:Cells( nHeaderRow, n ):Value := aFormat[ n ][ F_HEADER ]
oSheet:Columns( n ):Set( "HorizontalAlignment", aFormat[ n ] [ F_JUSTIFY ] )
oSheet:Columns( n ):Set( "ColumnWidth", aFormat[ n ] [ F_LEN ] )
oSheet:Columns( n ):Set( "NumberFormat", aFormat[ n ] [F_FMT ] )
oSheet:Cells( nHeaderRow, n ):Interior:Color := RGB(0,0,128)
oSheet:Cells( nHeaderRow, n ):Font:Color := RGB( 255, 255, 255 )
oSheet:Cells( nHeaderRow, n ):Interior:Pattern := 1
NEXT
cRange := "A" + chr( 48 + nHeaderRow ) + ":" + chr( len( aFormat ) + 64 ) + chr( 48 + nHeaderRow )
oSelection := oSheet:Range( cRange )
oSelection:Borders( 9 ):LineStyle := 1
oSelection:Borders( 9 ):Weight := 2
oSelection:Borders( 9 ):Set( "ColorIndex", -4105 )
nRow := nHeaderRow
oText:SetText( cCustName )
oMeter:nTotal := nTOTAL
oClp:Clear()
SysRefresh()
nPos := 1
nRow := nHeaderRow
KOPFAKTIV := .T.
DBSELECTAREA(1)
cCustName := (1)->Last
DO WHILE ! eof()
xRange := ltrim(str(nRow)) // Cell
nRow++
oClp:SetText( OemToAnsi( (1)->First ) + chr( 9 ) + ;
OemToAnsi( (1)->Last ) + chr( 9 ) + ;
OemToAnsi( (1)->State ) + chr( 9 ) + ;
OemToAnsi( (1)->Zip ) + chr( 9 ) + ;
OemToAnsi( (1)->City ) + chr( 9 ) + ;
OemToAnsi( (1)->Street ) + chr( 9 ) + ;
transform( (1)->Hiredate, "@D" ) + chr( 9 ) + ;
IIF( (1)->Married, "Yes", "No" ) + chr( 9 ) + ;
STR((1)->Age ) + chr( 9 ) + ;
transform( (1)->Salary, "@E 999,999.99" ) + chr( 9 ) + ;
OemToAnsi((1)->Notes) )
oSheet:Cells( nRow, 1 ):Select()
oSheet:Paste()
oClp:Clear()
DBSELECTAREA(1)
(1)->( DbSkip() )
nPos++
oMeter:Set( nPos )
oText:SetText( "Konto: " + (1)->Last )
SysRefresh()
ENDDO
oSheet:Cells( 2, 1 ):Select() // Cursor
oWorkBook:SaveAs("Customer-List.xls")
oClp:Clear()
oExcel:Visible := .T.
// oExcel:Quit() // if Excel runs at Background
oExcel := NIL
RETURN( NIL )