表格转excel.prg

田径运动会管理系统RAR 用VFP编写

*gridtoexcel.prg
*表格转excel
*调用方式 gridtoexcel(thisform.grid)
PARAMETERS lgrid
IF TYPE('lgrid')#'O'
 RETURN 1
ENDIF
IF lgrid.BaseClass # 'Grid'
 RETURN 2
ENDIF
PRIVATE lrec,i,j,k,obj
obj=CREATEOBJECT('Excel.application')
IF TYPE('obj')#"O"
 * 不能打开EXCEL,可能没装EXCEL!
 WAIT window nowait "不能打开EXCEL,可能没装EXCEL!"
 RETURN 3
ENDIF

lgrid.SetFocus
DOEVENTS
lrec=0
DO while RECNO()<>lrec
 lrec=RECNO()
 SKIP -1000000000
 lgrid.Refresh
 DOEVENTS
ENDDO

WITH obj
 .Workbooks.add
 .Worksheets("sheet1").Activate
 .visible=.t.
ENDWITH
FOR i=1 to lgrid.ColumnCount
 FOR j=1 to lgrid.columns(i).ControlCount
  IF lgrid.columns(i).Controls(j).BaseClass='Header'
   obj.cells(1,i)=lgrid.columns(i).Controls(j).caption
  ENDIF
 NEXT
NEXT
lrec=0
k=2
DO while RECNO()<>lrec
 FOR i=1 to lgrid.ColumnCount
  j=lgrid.columns(i).ControlSource
  IF TYPE(j)$'CNDLT' && 只写了支持5种数据类型
   DO case
    CASE TYPE(j)='C'
     j="'"+&j
    CASE TYPE(j)$'NDT'
     j=&j
    CASE TYPE(j)='L'
     j=IIF(j,'T','F')
   ENDCASE
   obj.cells(k,i)=j
  ENDIF
 NEXT
 lrec=RECNO()
 SKIP
 lgrid.Refresh
 DOEVENTS
 k=k+1
ENDDO
obj.Cells.Select
obj.Cells.EntireColumn.AutoFit
RELEASE obj