DEFINE DIALOG oDDAbmLins OF oWndIva RESOURCE "IVA_LINS"
REDEFINE BUTTON oBtnNewp ID 4002 OF oDDAbmLins ACTION (cTipmov:="" ,Insertarp())
REDEFINE BUTTON oBtnModp ID 4003 OF oDDAbmLins ACTION (cTipmov:="M",Modificap())
REDEFINE BUTTON oBtnDelp ID 4004 OF oDDAbmLins ACTION (cTipmov:="" ,Eliminarp())
REDEFINE BUTTON oBtnLin ID 4006 OF oDDAbmLins ACTION (deshabilitap(),oDbarra:Enable(),oBtnNew:Setfocus())
REDEFINE BUTTON oBtnCtop ID 4001 OF oDDAbmLins ACTION (If(Helppre(),VolHpre(.t.),VolHpre(.f.)),.T.)
REDEFINE GET oConcepp VAR cConcepp ID 104 OF oDDAbmLins VALID Conceptop()
REDEFINE GET oDescrip VAR cDescrip ID 105 OF oDDAbmLins
REDEFINE GET oImportp VAR nImportp PICTURE "@E 999,999,999.99" ID 106 OF oDDAbmLins VALID Importep()
REDEFINE SAY oDifp PROMPT nDifp ID 4005 OF oDDAbmLins
REDEFINE XBROWSE oLbx ID 110 OF oDDAbmlins;
HEADERS "NºObra","Asiento","Fecha","Cuenta","Cpto.","Descripcion","Base","Tipo";
COLUMNS "Obra", "Asiento", "fecha","Cuenta","Concepto","Descrip","Base","tipo" ;
SIZES 50,50,65,55,30,210,90,33;
ALIAS ("bliva");
ON CHANGE (Toma_Lin(), PonerScope("bliva","pliva",oLbxp),refrescapre())
// olBx:lHScroll:=.F. // windows style en el recurso = 0x50210000 SI, lHScroll .f. NO funciona
// oLbx:aCols[1]:lMergeVert := .t. // si lo pongo casca el programa
oLbx:nMarqueeStyle := MARQSTYLE_HIGHLROW // HighL Row := 5
oLbx:aCols[1]:bClrstd := {|| { CLR_BLACK, RGB(233,230,249) }}
REDEFINE XBROWSE oLbxp ID 120 OF oDDAbmlins;
HEADERS "Obra","Prespto","Descripcion","Importe";
COLUMNS "PL_OBRA","PL_PRES","PL_DESC","PL_IMPORT" ;
SIZES 45,40,175,80;
FOOTERS AUTOCOLS LINES CELL ;
ALIAS "pliva";
ON CHANGE (refrescapre())
oLbxp:bClrSelFocus := { || { CLR_BLUE, nRGB( 230, 255, 230 ) } }
oLbxp:aCols[1]:lMergeVert := .t.
// oLbxP:nMarqueeStyle := MARQSTYLE_HIGHLCELL // HighL Row := 5 MARQSTYLE_DOTEDCELL 1 MARQSTYLE_SOLIDCELL 2 MARQSTYLE_HIGHLCELL 3 MARQSTYLE_HIGHLROWRC 4 MARQSTYLE_HIGHLROW 5
oLbxp:aCols[1]:bClrstd := {|| { CLR_BLUE, RGB(250,252,213) }} // lo quito porque pongo lMergeVert
oLbxp:lFooter=.T.
oLbxp:aCols[4]:nFooterType := AGGR_TOTAL
ACTIVATE DIALOG oDDAbmLins NOWAIT;
ON INIT (oDifp:Disable(), Toma_Lin(),deshabilitap(),oLbx:Refresh(), oLbxp:Refresh())
oExcel := CreateObject( "Excel.Application" )
oExcel:WorkBooks:Add()
oAs := oExcel:Activesheet()
oAs:Cells:Font:Name := "Calibri"
oAs:Cells:Font:Size := 11
oAs:Columns( 1 ):ColumnWidth := 17
oAs:Columns( 2 ):ColumnWidth := 150
oAs:Cells( 3, 1 ):Value := "Prog"
oAs:Cells( 3, 2 ):Value := "Note"
n = 1
for n = 1 to 2
oAs:Cells(3,n):Borders(7):LineStyle := 1
oAs:Cells(3,n):Borders(8):LineStyle := 1
next
Use archivio
go top
n = 4
do while !eof()
sysrefresh()
oAs:Cells( n, 1 ):Value := archivio->c1) // prog
oAs:Cells( n, 2 ):Value := archivio->c2) // campo note
n = n+1
skip
enddo
n1 = 1
for n1 = 1 to 2
oAs:Cells(n-1,n1):Borders(9):LineStyle := 1
next
oAs:Columns( "A:B" ):WrapText = .T.
/*
oAs:Name := "NC"
* oAs:Columns( "A:T" ):AutoFit()
oAs:Columns( "A:Z" ):VerticalAlignment := -4108
oAs:Columns( "A:Z" ):HorizontalAlignment := -4108
oAs:Columns( "C:C" ):HorizontalAlignment := -4131
oAs:Columns( "Q:Q" ):HorizontalAlignment := -4131
oAs:Columns( "W:W" ):WrapText = .F.
oAs:Range("I2:Q2"):interior:color := rgb(184,204,228)
oAs:Range("I3:Q3"):interior:color := rgb(217,217,217)
oAs:Range("A3:H3"):interior:color := rgb(54,96,146)
oAs:Range("A3:H3"):font:color := rgb(255,255,255)
*/
oExcel:visible := .T
is it possible get in excel the same double headers?
function XbrToExcelWithGroups( oBrw )
local oExcel, oSheet
local n, nStart := 0, nUpto, cGrp, cPrv, oRange
if oBrw:lGrpHeader == .t.
oSheet := oBrw:ToExcel()
oExcel := oSheet:Parent:Application
WITH OBJECT oSheet:Rows( "1:1" )
:Insert()
:Font:Bold := .t.
END
for n := 1 to Len( oBrw:aCols )
cGrp := oBrw:aCols[ n ]:cGrpHdr
if Empty( cGrp )
cPrv := nil
if nStart > 0
oRange := oSheet:Range( oSheet:Cells( 1, nStart ), oSheet:Cells( 1, nUpto ) )
oRange:MergeCells := .t.
oRange:HorizontalAlignment := -4108
endif
nStart := 0
nUpto := 0
oRange := oSheet:Range( oSheet:Cells( 1, n ), oSheet:Cells( 2, n ) )
oRange:MergeCells := .t.
else
if cGrp == cPrv
nUpto := n
else
oSheet:Cells( 1, n ):Value := cGrp
cPrv := cGrp
if nStart > 0
oRange := oSheet:Range( oSheet:Cells( 1, nStart ), oSheet:Cells( 1, nUpto ) )
oRange:MergeCells := .t.
oRange:HorizontalAlignment := -4108
endif
nStart := n
nUpto := n
endif
endif
next
endif
return nil
nageswaragunupudi wrote:is it possible get in excel the same double headers?
As of now, oBrw:ToExcel() method exports all headers, data and footers of XBrowse but not Group Headers.
In FWH 17.03 oBrw:ToExcel() will export Group Headers also.
I am suggesting a function which adds Group Headers the excel sheet now being exported by XBrowse.
Please use this function to export from xbrowse instead of directly calling oBrw:ToExcel()
- Code: Select all Expand view
function XbrToExcelWithGroups( oBrw )
local oExcel, oSheet
local n, nStart := 0, nUpto, cGrp, cPrv, oRange
if oBrw:lGrpHeader == .t.
oSheet := oBrw:ToExcel()
oExcel := oSheet:Parent:Application
WITH OBJECT oSheet:Rows( "1:1" )
:Insert()
:Font:Bold := .t.
END
for n := 1 to Len( oBrw:aCols )
cGrp := oBrw:aCols[ n ]:cGrpHdr
if Empty( cGrp )
cPrv := nil
if nStart > 0
oRange := oSheet:Range( oSheet:Cells( 1, nStart ), oSheet:Cells( 1, nUpto ) )
oRange:MergeCells := .t.
oRange:HorizontalAlignment := -4108
endif
nStart := 0
nUpto := 0
oRange := oSheet:Range( oSheet:Cells( 1, n ), oSheet:Cells( 2, n ) )
oRange:MergeCells := .t.
else
if cGrp == cPrv
nUpto := n
else
oSheet:Cells( 1, n ):Value := cGrp
cPrv := cGrp
if nStart > 0
oRange := oSheet:Range( oSheet:Cells( 1, nStart ), oSheet:Cells( 1, nUpto ) )
oRange:MergeCells := .t.
oRange:HorizontalAlignment := -4108
endif
nStart := n
nUpto := n
endif
endif
next
endif
return nil
// -------------------------------------------------------------------- SECTION 1 Page 1 - 4
FUNCTION GRPC1_SEC1( oFld1, nSavePage )
LOCAL aBitmaps1, oTitle, oText1, oBtn1, oBtn2
...
...
...
@ 250, 25 BTNBMP oBtn1 OF oFld1:aDialogs[1] ;
SIZE 80, 15 PIXEL 2007 ;
NOBORDER ;
PROMPT " &Export sample 1 " ;
FILENAME c_Path1 + "EXCEL.bmp" ;
ACTION XBRTOEXCELWITHGROUPS( oBrw1 ) ;
FONT oSFont ;
LEFT
oBtn1:cToolTip = { "Excel","EXPORT", 1, CLR_BLACK, 14089979 }
oBtn1:SetColor( 0, )
@ 250, 120 BTNBMP oBtn2 OF oFld1:aDialogs[1] ;
SIZE 80, 15 PIXEL 2007 ;
NOBORDER ;
PROMPT " &oBrw1:ToExcel() " ;
FILENAME c_Path1 + "EXCEL.bmp" ;
ACTION oBrw1:ToExcel() ;
FONT oSFont ;
LEFT
oBtn2:cToolTip = { "Excel","EXPORT", 1, CLR_BLACK, 14089979 }
oBtn2:SetColor( 0, )
RETURN NIL
#include "fivewin.ch"
Function test()
Local oRange,lOpened:=.f.
Local aData
oRange := GetExcelRange( ExePath() + "Large file - All Data.xlsx" )
aData := ArrTranspose( oRange:Value )
xbrowse( aData )
oRange := NIL
return nil
function ExePath()
return cFilePath( GetModuleFileName() )
Return to FiveWin for Harbour/xHarbour
Users browsing this forum: Antonio Linares and 31 guests