在梅子论坛看到的一个Grid转Excl的程序，有点问题。
在梅子论坛看到的一个Grid转Excl的程序，有点问题。问题在红色字体那里，哪位能解决？
**====================================
*!*Create By Alan Hung
*!*Create Date 2012-06-15
*!*Modify Date 2016-11-01
**====================================
FUNCTION GridToExcel
LPARA LoGrid
LoGrid= thisform.grid1
IF VARTYPE(oGrid)='O'
IF UPPER(oGrid.BASECLASS)<>'GRID'
oGrid=''
ENDIF
ENDIF
LTable=.f.
if vartype(oGrid)='C'
if !used(oGrid)
oGrid=ALIAS()
ENDIF
LTable=.t.
ENDIF
&&获取数据源
LOCAL m.cTableName,FileRate
m.cTableName=''
if LTable=.f.
IF VARTYPE(oGrid)<>'O'
FOR EACH oGrid IN _screen.ActiveForm.CONTROLS
IF UPPER(oGrid.BASECLASS)='GRID' AND oGrid.VISIBLE=.T.
EXIT
ELSE
LOOP
ENDIF
ENDFOR
IF UPPER(oGrid.BASECLASS)<>'GRID'
RETURN .F.
ENDIF
ENDIF
m.cTableName=ALLT(oGrid.RECORDSOURCE)
IF NOT USED(m.cTableName)
RETURN
ENDIF
Else
m.cTableName=oGrid
ENDIF
IF !USED(m.cTableName) OR EMPTY(m.cTableName)
MESSAGEBOX('Grid數據源為空，不能導出數據。',64,'提示')
RETURN
ENDIF
oExcelApp=CREATEOBJECT('Excel.Application')
IF NOT TYPE("oExcelApp") = "O"
=MESSAGEBOX("Excel對象建立失敗，程序將中止！", 16, "Error")
RETURN
ENDIF
LOCAL oColumn,cFields,nFldCount,FieldName,MemoFields,LMemo,MemoOrder
MemoFields=''
cFields=''
MemoOrder=''
oExcelApp.DisplayAlerts=.F.
oExcelApp.VISIBLE=.f. &&我发现，当存在分页时，oExcelApp.VISIBLE=.f. 就会报错，当为oExcelApp.VISIBLE=.T.就不报错
**************************************************************************************************************************
DO WHILE oExcelApp.Workbooks.COUNT<2
oExcelApp.Workbooks.ADD()
ENDDO
oExcelApp.Workbooks(2).ACTIVATE
oExcelApp.ActiveWindow.WINDOWSTATE=2
oSheet = oExcelApp.ActiveSheet
LOCAL lTalk,lSafe
lTalk=SET('talk')
lSafe=SET('safe')
SET TALK OFF
SET SAFE OFF
&&获取表头，获取非隐藏字段
LOCAL NewTableName,ii
NewTableName=SYS(2015)
if LTable=.f.
ii = 1
FOR i0611 = 1 TO oGrid.COLUMNCOUNT
FOR EACH oColumn IN oGrid.COLUMNS
IF oColumn.COLUMNORDER=i0611 AND oColumn.VISIBLE=.T. AND oColumn.Width>0 &&列宽等于0的不处理，列隐藏不处理
LOCAL aCaption[ii]
aCaption[ii]=ALLT(oColumn.Header1.CAPTION)
CurFieldName=GETWORDNUM(oColumn.CONTROLSOURCE,2,'.') &&去掉表名，取字段名
IF TYPE(CurFieldName)='T' &&把时间类型字段改为字符
cFields=cFields+IIF(EMPTY(cFields),'',',PADR(TTOC(')+CurFieldName+'),19,SPACE(1))'+' As '+CurFieldName
ELSE
cFields=cFields+IIF(EMPTY(cFields),'',',')+CurFieldName
ENDIF
ii = ii + 1
ENDIF
ENDFOR
ENDFOR
IF EMPTY(cFields)
RETURN
ENDIF
SELECT &cFields FROM (m.cTableName) INTO CURSOR (NewTableName)
Else
SELECT * FROM (m.cTableName) into cursor (NewTableName)
ENDIF
SELECT (NewTableName)
nFldCount=AFIELD(aFldList,NewTableName)
&&判断是否有备注字段
lMemo=.F.
nStartMemoOrder=0
nEndMemoOrder=0
FOR ii=1 TO nFldCount
IF aFldList[ii,2]='M'
LMemo=.T.
IF nStartMemoOrder=0
nStartMemoOrder=ii
ENDIF
nEndMemoOrder=ii
ENDIF
ENDFOR
nLine=RECCOUNT(NewTableName)
cRecc = STR(nLine)
nMaxCount= oSheet.ROWS.COUNT - 1 &&留下标题栏
nMaxCount= 4500 &&我在测试时，为了测试分页功能；正常情况使用时，要去掉此行。
*************************************************************************************************************************************
nSheet = CEILING(nLine/nMaxCount) &&获取Sheet数
FileRate=CHRTRAN(TRANSFORM(DATETIME()),' :-.','')
LcCaption=ALLT(_screen.ActiveForm.CAPTION)
cExcelFile=LcCaption+'_'+TRAN(FileRate)+".xls"
DO WHILE FILE(cExcelFile)
cExcelFile=LcCaption+'_'+TRAN(FileRate)+".xls"
FileRate=CHRTRAN(TRANSFORM(DATETIME()),' :-.','')
IF FILE(cExcelFile)
LOOP
ELSE
EXIT
ENDIF
ENDDO
cExcelFile=PUTFILE('文件保存為(&N):',cExcelFile,'XLS')
IF EMPTY(cExcelFile)
RETURN
ENDIF
cMessageText ='系統正在導出數據到Excel......'
WAIT WINDOW cMessageText AT SROW()/2,(SCOLS()-LEN(cMessageText))/2 NOWAIT NOCLEAR
LOCAL ARRAY TempExcel(nSheet)
dStartDate=DATETIME()
IF !DIRECTORY('temp')
MD ('temp')
ENDIF
SELECT (NewTableName)
GO TOP
FOR i=1 TO nSheet
TempExcel(i) ='temp\'+SYS(2015)+'.dbf'
tname = FULLPATH(TempExcel(i))
IF FILE(tname)
DELETE FILE (tname)
ENDIF
COPY TO (tname) NEXT (nMaxCount) TYPE FOX2X
ENDFOR
&&添加Sheet
DO WHILE oExcelApp.Workbooks(2).worksheets.COUNT<nSheet
oExcelApp.Workbooks(2).worksheets.ADD
ENDDO
FOR i=1 TO nSheet
tname = FULLPATH(TempExcel(i))
oExcelApp.Workbooks(1).ACTIVATE
oExcelApp.Workbooks.OPEN(tname)
oExcelApp.ActiveSheet.UsedRange.COPY
oExcelApp.Workbooks(2).ACTIVATE
oExcelApp.Worksheets(i).ACTIVATE &&出错在这行，OLE 错误码 0x8002000b: Invalid index，但当设置oExcelApp.VISIBLE=.T.就不报错
***********************************************************************************************************************
oExcelApp.Worksheets(i).NAME=LcCaption+'_'+ALLT(STR(i))
oExcelApp.RANGE( "A1:A1 ").SELECT
oExcelApp.ActiveSheet.Paste
if !LTable &&替换Grid Title
nTitle0209=alen(aCaption)
for z=1 to nTitle0209
oExcelApp.ActiveSheet.cells(1,z).value=aCaption[z]
endfor
ENDIF
oExcelApp.ActiveSheet.ROWS(1).FONT.NAME="黑体"
oExcelApp.ActiveSheet.ROWS(1).FONT.Bold=.T.
oExcelApp.ActiveSheet.ROWS(1).HorizontalAlignment=3
oExcelApp.ActiveSheet.UsedRange.SELECT
&&排版
oExcelApp.SELECTION.ROWHEIGHT = 15
oExcelApp.SELECTION.COLUMNS.autofit
oExcelApp.SELECTION.BORDERS(1).LineStyle=1
oExcelApp.SELECTION.BORDERS(2).LineStyle=1
oExcelApp.SELECTION.BORDERS(3).LineStyle=1
oExcelApp.SELECTION.BORDERS(4).LineStyle=1
oExcelApp.SELECTION.FONT.SIZE=9
&&處理備註字段
IF LMemo
IF USED('BillyTemp')
USE IN BillyTemp
ENDIF
USE (tname) ALIAS BillyTemp SHARED
SELECT BillyTemp
GO TOP
j=2
SCAN
FOR N=nStartMemoOrder TO nEndMemoOrder
IF aFldList[N, 2] = "M"
oExcelApp.ActiveSheet.cells(j,N).VALUE=EVAL(aFldList[N, 1])
ELSE
LOOP
ENDIF
ENDFOR
j=j+1
ENDS
USE IN BillyTemp
ENDIF
ENDFOR
WAIT CLEAR
oExcelApp.ActiveWorkbook.SAVEAS(cExcelFile)&&保存數據
oExcelApp.DisplayAlerts=.T.
oExcelApp.ActiveWorkbook.CLOSE(.F.)
oExcelApp.Workbooks.CLOSE
oExcelApp.QUIT
&&Excel 退出
Use in (NewTableName) &&關閉臨時表
STORE NULL TO oExcelApp,oExcelSheet
RELEASE oExcelApp,oExcelSheet
dEndDate=DATETIME()
MESSAGEBOX('数据成功导出，耗时：'+TRANSFORM(dEndDate-dStartDate)+'秒。合计：'+TRANSFORM(nLine)+'条记录！',64,'导出数据')
DECLARE INTEGER ShellExecute IN shell32.DLL INTEGER HWND,STRING, ;
STRING lpszFile, STRING, STRING, INTEGER
operate= "open"
ShellExecute(0,operate,cExcelFile,0,0,1) && EXCEL文件
SET TALK &lTalk
SET SAFE &lSafe
ENDFUNC
程序代码：
