Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Sum in excel
Message
 
 
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Titre:
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Vista
Network:
Windows 2008 Server
Database:
MS SQL Server
Divers
Thread ID:
01355873
Message ID:
01356908
Vues:
29
I found a significant flow in this function but I really don't have time to fix and investigate :(

Two questions.

1. How can I get intellisense for something like loSheet?

2. For my title I want it to be centered for all the columns I passed for my headers. How exactly can I do this (and remove the lines between cells for the title)?

Thanks a lot in advance.

>>how do i get a total on a particular cell when i transfer my data to excel from foxpro
>
>See Excel insert a sum function in code Message #1302704
>
>See also this function
>
>************************************************************
>*  FUNCTION DBFToExcel()
>************************************************************
>*) Description.......: Creates an Excel file from open table / cursor
>*  Calling Samples...: DbfToExcel(m.lcXLSFile, @laHeader_Info, "Batch Statistics")
>*  Parameter List....: tcXLSFileName, taHeader_Info, tcTitle, tcPassword, tlLockHeaderRow
>*  Major change list.:
>FUNCTION DBFToExcel
>LPARAMETERS tcXLSFileName, taHeader_Info, tcTitle, tcPassword, tlLockHeaderRow
>EXTERNAL ARRAY taHeader_Info
>* This function assumes, that the output table (cursor) is currently opened
>*-- Generate output to XLS File
>* -- Do some basic parameter checking
>IF EMPTY(ALIAS())
>	RETURN "No table/cursor is currently opened to process."
>ENDIF
>
>IF EMPTY(m.tcXLSFileName)
>	RETURN "Excel file name is not passed."
>ENDIF
>
>IF TYPE("taHeader_Info[1]") <> "C"
>	RETURN "Array taHeader_Info is not passed."
>ENDIF
>
>IF VARTYPE(m.tcTitle) <> "C"
>	RETURN "Excel title is not passed."
>ENDIF
>
>LOCAL loExcel, lnI, loSheet, lnK, lcError, lnLines, ;
>	lnActualFields, lnHeaderCells, lcRange, lcStart, lcEnd, lnCols, lnOffset
>lcError = ""
>
>LOCAL ARRAY laTitle[1]
>
>IF NOT EMPTY(m.tcTitle)
>	lnLines = ALINES(laTitle, m.tcTitle)
>	lnOffset = 2
>ELSE
>	lnLines = 0
>	lnOffset = 1
>ENDIF
>
>#include Excel.h
>#DEFINE xlPart   2
>
>TRY
>	lnActualFields = FCOUNT()
>	lnHeaderCells = ALEN(taHeader_Info,1)
>	COPY TO (m.tcXLSFileName) TYPE XL5
>	*-- Create Ole Automation with Excel
>	loExcel = CREATEOBJECT("Excel.Application")
>	*-- Open XLS File
>	loExcel.APPLICATION.WorkBooks.OPEN(m.tcXLSFileName)
>
>	loExcel.DisplayAlerts = .F.
>
>	FOR lnI = 1 TO loExcel.APPLICATION.APPLICATION.WorkBooks(1).Sheets.COUNT
>		*-- Select individual sheets from open XLS File
>		loSheet = loExcel.APPLICATION.APPLICATION.WorkBooks(1).Sheets(m.lnI)
>
>		** Delete the column headers from Excel (first row)
>		loSheet.ROWS("1").DELETE(xlShiftDown)
>
>		** Insert lines with Title + 1 or 2 empty rows for the column headers
>		loSheet.ROWS("1:" + ALLTRIM(STR(m.lnLines + m.lnOffset))).INSERT(xlShiftDown)
>
>		IF m.lnLines > 0 && Title font
>			WITH loSheet.RANGE("1:" + ALLTRIM(STR(m.lnLines))).FONT
>				.COLOR = 8388736 && rgb(255,0,0)
>				.SIZE  = 14
>				.Bold  = .T.
>				.NAME = 'Tahoma'
>			ENDWITH
>		ENDIF
>		** Header font
>		WITH loSheet.RANGE(ALLTRIM(STR(m.lnLines + 1)) + ;
>				":" + ALLTRIM(STR(m.lnLines + m.lnOffset))).FONT
>			*  .Color = Rgb(255,0,0)
>			.SIZE  = 11
>			.Bold  = .T.
>			.NAME = 'Tahoma'
>		ENDWITH
>
>		*!*			With loSheet.Range("1:2").Borders
>		*!*			  .Weight = xlMedium
>		*!*			  .LineStyle = xlContinuous
>		*!*			 Endwith
>		FOR lnK = 1 TO m.lnLines
>			loSheet.Cells(m.lnK, 1).VALUE = laTitle[m.lnK]
>		NEXT
>
>		FOR lnK = 1 TO m.lnHeaderCells
>			loSheet.Cells(m.lnOffset + m.lnLines, m.lnK).VALUE = ;
>				taHeader_Info[m.lnK,1] + ;
>				IIF(EMPTY(taHeader_Info[m.lnK,2]), "", ;
>				CHR(10) + taHeader_Info[m.lnK,2])
>			*			loSheet.Cells(3 + m.lnLines,m.lnK).value = taHeader_Info[m.lnK,2]
>
>			IF !EMPTY(taHeader_Info[m.lnK,3]) && There is format information
>				loRange = loSheet.UsedRange.Offset(m.lnLines + m.lnOffset) && we don't want to apply format for header rows
>				loRange.COLUMNS[m.lnK].NumberFormat = taHeader_Info[m.lnK,3]
>			ENDIF
>
>			IF !EMPTY(taHeader_Info[m.lnK,4]) && There is Column Width
>				loSheet.COLUMNS[m.lnK].SELECT
>				loSheet.COLUMNS[m.lnK].COLUMNWIDTH = taHeader_Info[m.lnK,4]
>			ELSE
>				loSheet.COLUMNS[m.lnK].AUTOFIT()
>			ENDIF
>		NEXT
>	NEXT
>
>	IF m.lnHeaderCells > m.lnActualFields
>		lnCols = m.lnActualFields + 1
>		** Code from Sergey Berezniker
>		lcStart = IIF(m.lnCols>26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ;
>			CHR(((m.lnCols - 1) % 26) + 65)
>		lnCols = m.lnHeaderCells
>		lcEnd = IIF(m.lnCols > 26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ;
>			CHR(((m.lnCols - 1) % 26) + 65)
>		lcRange = m.lcStart + ALLTRIM(STR(m.lnLines + m.lnOffset)) + ":" + ;
>			M.lcEnd + ALLTRIM(STR(m.lnLines + m.lnOffset))
>
>		WITH loSheet.RANGE(m.lcRange).Interior
>			.ColorIndex = 33 && Blue Color
>			.PATTERN = xlSolid
>			.PatternColorIndex = xlAutomatic
>		ENDWITH
>	ELSE
>		lnCols = m.lnActualFields
>		lcEnd = IIF(m.lnCols > 26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ;
>			CHR(((m.lnCols - 1) % 26) + 65)
>	ENDIF
>
>	** Made the Totals row in bold and Green highlight
>	loExcel.RANGE([A1], loExcel.SELECTION.SpecialCells(xlLastCell)).SELECT
>	loExcel.SELECTION.FormatConditions.DELETE
>	loExcel.SELECTION.FormatConditions.ADD(xlExpression,, '=UPPER(Left($A1,5))="TOTAL"')
>
>	WITH loExcel.SELECTION.FormatConditions(1)
>		.FONT.Bold = .T.
>		.Interior.ColorIndex = 4
>	ENDWITH
>
>	** Now apply borders to each header cell
>	lcRange = "A" + ALLTRIM(STR(m.lnLines + m.lnOffset)) + ":" + ;
>		M.lcEnd + ALLTRIM(STR(m.lnLines + m.lnOffset))
>
>	WITH loSheet.RANGE(m.lcRange)
>		WITH .BORDERS(xlEdgeLeft)
>			.LineStyle = xlContinuous
>			.Weight = xlThin
>			.ColorIndex = xlAutomatic
>		ENDWITH
>		WITH .BORDERS(xlEdgeTop)
>			.LineStyle = xlContinuous
>			.Weight = xlThin
>			.ColorIndex = xlAutomatic
>		ENDWITH
>		WITH .BORDERS(xlEdgeBottom)
>			.LineStyle = xlContinuous
>			.Weight = xlThin
>			.ColorIndex = xlAutomatic
>		ENDWITH
>		WITH .BORDERS(xlEdgeRight)
>			.LineStyle = xlContinuous
>			.Weight = xlThin
>			.ColorIndex = xlAutomatic
>		ENDWITH
>		WITH .BORDERS(xlInsideVertical)
>			.LineStyle = xlContinuous
>			.Weight = xlThin
>			.ColorIndex = xlAutomatic
>		ENDWITH
>	ENDWITH
>
>	IF m.tlLockHeaderRow && we need to prevent headers from modifying
>		** Code from Borislav Borissov
>		loSheet.UsedRange.SELECT
>		loExcel.SELECTION.Locked = .F. && First we need to UNLOCK all cells
>		loExcel.ROWS(m.lnLines + m.lnOffset).SELECT && Select the header row of the sheet
>		loExcel.SELECTION.Locked = .T. && Lock Cells in the header row
>		loExcel.ActiveWorkbook.ActiveSheet.PROTECT(,.T.,,.T.)
>	ENDIF
>
>	loExcel.RANGE([A1]).SELECT && So we would not end up with whole file selected
>	IF NOT EMPTY(m.tcPassword)
>
>		loExcel.ActiveWorkbook.PASSWORD = m.tcPassword && Works in Excel 2003
>	ENDIF
>
>	loExcel.SAVE()
>
>CATCH TO loError
>	lcError = Log_Error(m.loError)
>FINALLY
>	IF VARTYPE(m.loExcel) = 'O'
>		loExcel.QUIT
>		RELEASE loExcel
>	ENDIF
>ENDTRY
>
>RETURN m.lcError
>ENDFUNC
>
If it's not broken, fix it until it is.


My Blog
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform