Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Excel replace function
Message
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Environment versions
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Network:
Windows 2003 Server
Database:
Visual FoxPro
Miscellaneous
Thread ID:
01096827
Message ID:
01101865
Views:
14
; doesn't work.

Anyway, I think I need to use SaveAs in order to avoid the dialog. E.g. first I would save to temp file and then would do SaveAs. Am I right?
************************************************************
*  FUNCTION DBFToExcel()
************************************************************
*  Author............: VCS  Developers Team
*  Project...........: Visual Collections System
*  Created...........: 03/03/2006  10:05:42
*  Copyright.........: (c) Jzanus, 2006
*) Description.......:
*  Calling Samples...: DbfToExcel(m.lcXLSFile, @laHeader_Info)
*  Parameter List....: tcXLSFileName, taHeader_Info
*  Major change list.:
function DBFToExcel
lparameters tcXLSFileName, taHeader_Info, tcHighlightString
* This function assumes, that the output table (cursor) is currently opened
*-- Generate output to XLS File
IF EMPTY(m.tcHighlightString)
	tcHighlightString = "TOTALS:"
ENDIF
	
local loExcel, lnI, loSheet, lnK, lcTempFile, lcError, loRange
*lcTempFile = addbs(sys(2023)) + "TempXLS" + sys(3) + ".XLS"
lcError = ""

#include Excel.h
#define xlPart   2

*-- Add Header into XLS File
try
	copy to (m.tcXLSFileName) type xl5
*-- Create Ole Automation with Excel
	loExcel=createobject("Excel.Application")
*-- Open XLS File
	loExcel.application.WorkBooks.open(m.tcXLSFileName)
	for lnI = 1 to loExcel.application.application.WorkBooks(1).Sheets.count
*-- Select individual sheet from open XLS File
		loSheet = loExcel.application.application.WorkBooks(1).Sheets(m.lnI)
*		loSheet.select

** Delete the column headers from Excel (first row)
		loSheet.rows("1").delete(xlShiftDown)
		loSheet.rows("1:3").insert(xlShiftDown)

		with loSheet.range("1:2").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 alen(taHeader_Info,1)
			loSheet.Cells(1,m.lnK).value = taHeader_Info[m.lnK,1]
			loSheet.Cells(2,m.lnK).value = taHeader_Info[m.lnK,2]

			if !empty(taHeader_Info[m.lnK,3]) && There is format information
				loRange = loSheet.UsedRange.Offset(3,0)
				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]
			endif
		next
	next

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

catch to loError
	lcError = Log_Error(m.loError)
finally
	if vartype(m.loExcel) = 'O'
		loExcel.quit
	endif
endtry
if not empty(m.lcError)
	=ErrorMsg(m.lcError)
endif
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