Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Excel Automation Formatting and F9
Message
 
 
To
08/01/2009 09:01:22
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Environment versions
Visual FoxPro:
VFP 8 SP1
OS:
Windows XP SP2
Network:
Novell 6.x
Database:
Visual FoxPro
Application:
Desktop
Miscellaneous
Thread ID:
01372023
Message ID:
01372036
Views:
60
>I am doing some Excel Automation and I extract out a table, then I do some formatting to some of the columns. I replace the values of the tables with an alltrim on the value from the main table to make sure there are no spaces to mess up the formatting. Some formatting are like a social as ###-##-#### and Phone as (###)###-####. The formatting gets set properly, but it does not show correctly on the excel sheet result. If you click on one of the values and click the cursor on the value in the = box then click somewhere else, it updates the cell showing that value with the correct formatting, but only that cell. If I highlight the whole column and hit F9, it still does not show the values with the correct formatting. Any ideas?

I think the column may be not wide enough. Did you try to AutoFit ? Also did you try to set NumberFormat for the column?

I don't have the same problem with the Excel automation program I have.
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, ;
	lnTotalRows, lcStartRow, lcEndRow

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 XLS

*-- 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

		lnCols = m.lnHeaderCells
		lcEnd = IIF(m.lnCols > 26, CHR(INT((m.lnCols - 1) / 26) + 64), "") + ;
			CHR(((m.lnCols - 1) % 26) + 65)
		lcRange = "A1:" + m.lcEnd + ALLTRIM(STR(m.lnLines))
		loSheet.RANGE(lcRange).SELECT

		WITH loExcel.SELECTION
			.HorizontalAlignment = xlCenter
			.VerticalAlignment = xlBottom
			.WrapText = .F.
			.ORIENTATION = 0
			.AddIndent = .F.
			.IndentLevel = 0
			.ShrinkToFit = .F.
			.ReadingOrder = xlContext
			.MergeCells = .T.
		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

		lnTotalRows = loSheet.UsedRange.ROWS.COUNT

		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

			IF TYPE("taHeader_Info[m.lnK,5]")="C" AND !EMPTY(taHeader_Info[m.lnK,5]) && There is a formula or text cell
				lcEnd = IIF(m.lnK > 26, CHR(INT((m.lnK - 1) / 26) + 64), "") + ;
					CHR(((m.lnK - 1) % 26) + 65)

				lcStartRow = ALLTRIM(STR(m.lnLines + m.lnOffset + 1))

				lcEndRow = ALLTRIM(STR(m.lnTotalRows))

				DO CASE

				CASE taHeader_Info[m.lnK,5] = "TEXT"
					loSheet.Cells(lnTotalRows + 2,m.lnK).VALUE = "TOTALS:"
					loSheet.Cells(lnTotalRows + 2,m.lnK).FONT.Bold  = .T.
					loSheet.Cells(lnTotalRows + 2,m.lnK).FONT.NAME = 'Tahoma'

				CASE taHeader_Info[m.lnK,5] ="SUM"
					loSheet.Cells(lnTotalRows + 2,m.lnK).formula = "=SUM(" + lcEnd + lcStartRow + ":" + lcEnd + lcEndRow + ")"
					IF !EMPTY(taHeader_Info[m.lnK,3]) && There is format information
						loSheet.Cells(lnTotalRows + 2,m.lnK).NumberFormat = taHeader_Info[m.lnK,3]
					ENDIF

				CASE taHeader_Info[m.lnK,5] ="COUNT"
					loSheet.Cells(lnTotalRows + 2,m.lnK).formula = "=COUNTA(" + lcEnd + lcStartRow + ":" + lcEnd + lcEndRow + ")"
					IF !EMPTY(taHeader_Info[m.lnK,3]) && There is format information
						loSheet.Cells(lnTotalRows + 2,m.lnK).NumberFormat = taHeader_Info[m.lnK,3]
					ENDIF

				ENDCASE
			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
		IF ALEN(taHeader_Info,1) > 1
			WITH .BORDERS(xlInsideVertical)
				.LineStyle = xlContinuous
				.Weight = xlThin
				.ColorIndex = xlAutomatic
			ENDWITH
		ENDIF
	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)
** Works in newer versions of Word
		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
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform