Hola
esto el lo que ocupo yo para lo que solicitas:
Archivo RC para WorkShop
0_EXCEL01 DIALOG 187, 195, 527, 92
STYLE 0x4L | WS_POPUP | WS_VISIBLE | WS_BORDER
FONT 8, "Segoe UI Symbol"
{
PUSHBUTTON "&Aceptar", 18, 192, 58, 69, 20
PUSHBUTTON "&Exit", 19, 265, 58, 69, 20
CTEXT "Text", 10, 12, 10, 503, 21
CONTROL "", 13, "msctls_progress32", 0 | WS_CHILD | WS_VISIBLE, 48, 46, 430, 3
Función para el usuario para la construcción del excel ( solo como ejemplo )
FUNCTION ExportExcel( oBrw, cTitulo )
LOCAL oDlg, oMet, oB
DEFINE BRUSH oB GRADIENT { { 1, nRgb( 74, 97, 132 ), nRgb( 33, 47, 72 ) } }
DEFINE DIALOG oDlg RESOURCE "0_EXCEL01" BRUSH oB
REDEFINE STSAY ID 10 PROMPT "Enviar datos a Microsoft Excel®" OF oDlg FONT oApp:aWFont[4] COLOR nRGB(252,224, 29), __CLR85
oMet := TProgress():Redefine( 13, oDlg )
REDEFINE SBUTTON ID 18 PROMPT "Construir" OF oDlg ACTION ( ExcelConstructor( oBrw, oMet, cTitulo ), oDlg:End() ) NOBOX RECT FONT oApp:aWFont[2] COLOR FRE_FBTN, { FRE_RBTN, __CLR87 }
REDEFINE SBUTTON ID 19 PROMPT "Abandonar" OF oDlg ACTION oDlg:End() NOBOX RECT FONT oApp:aWFont[2] COLOR FRE_FBTN, { FRE_RBTN, __CLR87 }
ACTIVATE DIALOG oDlg CENTER
oB:End()
oBrw:Refresh()
oBrw:Gotop()
oBrw:SetFocus()
RETURN .T.
funcion de construccion del excel en base al xBrowse enviado
FUNCTION ExcelConstructor( oBrw, oMeter, cTitle )
LOCAL oExcel, oBook, oSheet, nRow, nCol, uData, nEvery, oRange, cRange, cCell, cLet, nColHead, bError, cText, oClip, nStart, aRepl, ;
nLine := 1, nCount := 0, aCol := { 26, 52, 78, 104, 130, 156 }, aLet := { "", "A", "B", "C", "D", "E" }, xWin
CursorWait()
cLet := aLet[ ASCAN( aCol, {|e| LEN( oBrw:aCols ) <= e } ) ]
IF !EMPTY( cLet )
nCol := ASCAN( aLet, cLet ) - 1
cLet += CHR( 64 + LEN( oBrw:aCols ) - aCol[ MAX( 1, nCol ) ] )
ELSE
cLet := CHR( 64 + LEN( oBrw:aCols ) )
ENDIF
aRepl := {}
oMeter:SetRange( 0, ( oBrw:nLen + 1 ) )
oMeter:Setpos( 0 )
oMeter:Refresh()
nEvery := MAX( 1, INT( ( oBrw:nLen + 1 ) * .02 ) )
bError := ErrorBlock( { | x | Break( x ) } )
BEGIN SEQUENCE
oExcel := TOleAuto():New("Excel.Application")
RECOVER
ErrorBlock( bError )
CursorArrow()
MsgFlip( "Excel no se encuentra instalado..." )
RETURN Nil
END SEQUENCE
ErrorBlock( bError )
nCount -= 15
oMeter:SetPos( nCount )
oExcel:ScreenUpdating := .F.
oExcel:WorkBooks:Add()
oBook := oExcel:Get( "ActiveWorkBook")
oSheet := oExcel:Get( "ActiveSheet" )
nCount -= 15
oMeter:SetPos( nCount )
( oBrw:cAlias )->( Eval( oBrw:bGoTop() ) )
cText := ""
FOR nRow := 1 TO oBrw:nLen
IF nRow == 1
oSheet:Cells( nLine++, 1 ):Value := cTitle
oSheet:Range( "A1:" + cLet + "1" ):Set( "HorizontalAlignment", 7 )
++nLine
nStart := nLine
nColHead := 0
FOR nCol := 1 TO LEN( oBrw:aCols )
uData := IIF( VALTYPE( oBrw:aCols[ nCol ]:cHeader ) == "B", EVAL( oBrw:aCols[ nCol ]:cHeader ), oBrw:aCols[ nCol ]:cHeader )
IF VALTYPE( uData ) != "C"
LOOP
ENDIF
uData := STRTRAN( uData, CRLF, Chr( 10 ) )
nColHead ++
oSheet:Cells( nLine, nColHead ):Value := uData
IF nCount % nEvery == 0
oMeter:SetPos( nCount )
ENDIF
nCount ++
NEXT
nStart := ++ nLine
ENDIF
FOR nCol := 1 To Len( oBrw:aCols )
uData := EVAL( oBrw:aCols[ nCol ]:bEditValue )
IF VALTYPE( uData ) == "C" .AND. AT( CRLF, uData ) > 0
uData := STRTRAN( uData, CRLF, "&&" )
IF ASCAN( aRepl, nCol ) == 0
AADD( aRepl, nCol )
ENDIF
ENDIF
IF oBrw:aCols[ nCol ]:cEditPicture != Nil
uData := TRANSFORM( uData, oBrw:aCols[ nCol ]:cEditPicture )
ENDIF
uData := IIF( VALTYPE( uData )=="D", DTOC( uData ), ;
IIF( VALTYPE( uData )=="N", STR( uData ) , ;
IIF( VALTYPE( uData )=="L", IIF( uData ,".T." ,".F." ), cValToChar( uData ) ) ) )
cText += TRIM( uData ) + Chr( 9 )
IF nCount % nEvery == 0
oMeter:SetPos( nCount )
ENDIF
nCount ++
NEXT
oBrw:Skip( 1 )
cText += CHR( 13 )
++nLine
IF LEN( cText ) > 400000
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
cCell := "A" + AllTrim( Str( nStart ) )
oRange := oSheet:Range( cCell )
oRange:Select()
oSheet:Paste()
oClip:End()
cText := ""
nStart := nLine + 1
ENDIF
NEXT
IF ASCAN( oBrw:aCols, { |o| o:cFooter != Nil } ) > 0
FOR nCol := 1 TO LEN( oBrw:aCols )
uData := IIF( VALTYPE( oBrw:aCols[ nCol ]:cFooter ) == "B", EVAL( oBrw:aCols[ nCol ]:cFooter ), oBrw:aCols[ nCol ]:cFooter )
uData := cValTochar( uData )
uData := STRTRAN( uData, CRLF, Chr( 10 ) )
oSheet:Cells( nLine, nCol ):Value := uData
NEXT
ENDIF
oSheet:Rows( 1 ):Font:Bold := .T.
( oBrw:cAlias )->( DbGoTop() )
IF LEN( cText ) > 0
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
cCell := "A" + AllTrim( Str( nStart ) )
oRange := oSheet:Range( cCell )
oRange:Select()
oSheet:Paste()
oClip:End()
cText := ""
ENDIF
nLine := If( ! Empty( cTitle ), 3, 1 )
cRange := "A" + LTrim( Str( nLine ) ) + ":" + cLet + AllTrim( Str( oSheet:UsedRange:Rows:Count() ) )
oRange := oSheet:Range( cRange )
oRange:Font:Name := "Roboto Cn"
oRange:Font:Size := 12
oRange:Font:Bold := .F.
IF ! EMPTY( aRepl )
FOR nCol := 1 TO LEN( aRepl )
oSheet:Columns( CHR( 64 + aRepl[ nCol ] ) ):REPLACE( "&&", CHR( 10 ) )
NEXT
ENDIF
oSheet:Rows( 1 ):Font:Size := 14
oSheet:Rows( 1 ):Font:Bold := .T.
oSheet:Rows( 1 ):RowHeight := 30
oSheet:Rows( 1 ):Font:ColorIndex := 25
oSheet:Rows( 3 ):Font:Bold := .T.
oSheet:Rows( 3 ):Font:ColorIndex := 20
oSheet:Rows( 3 ):RowHeight := 25
oRange:Borders():LineStyle := 1
oRange:Columns:AutoFit()
IF ! Empty( aRepl )
FOR nCol := 1 TO LEN( aRepl )
oSheet:Columns( CHR( 64 + aRepl[ nCol ] ) ):WrapText := .T.
NEXT
ENDIF
oMeter:SetPos( ( oBrw:nLen + 1 ) )
oSheet:Range( "A3:"+cLet+"3" ):Interior:ColorIndex := 49
oSheet:Range( "A3:"+cLet+"3" ):Borders:ColorIndex := 2
oSheet:Range( "A4" ):Select()
xWin := oExcel:ActiveWindow
*xWin:SplitRow := 3
oExcel:ScreenUpdating := .t.
oExcel:Visible := .T.
ShowWindow( oExcel:hWnd, 3 )
BringWindowToTop( oExcel:hWnd )
CursorArrow()
RETURN NIL
lo uso aplicandolo a un boton cualquiera ( marcado en la imagen )
REDEFINE SBUTTON ID 43 FILENAME ".\System\SendToExcel.bmp" OF oDlg ACTION ExportExcel( oBrw,"DESPACHOS EFECTUADOS EN TEMPORADA") ;
COLOR __CLRBOTON TOOLTIP "Traslado de información..."
Resultado :
Espero que te sirva
PD. aplicable para versiones antiguas de FiveWin.
