dy.prg

vfp转换成excel表格

PUBLIC p_bjmc,p_bjdm,p_bjrs,p_kblb,p_wldm,kcs
SET TALK OFF
SET SAFETY OFF
SET STATUS OFF
SET STATUS bar OFF
pmh=_screen.Width
pmv=_screen.Height
wz1=INT((INT(pmh/7)-60)/2)
wz2=INT((INT(pmv/15.7)+1)/2)
kcs=10
b_year=ALLTRIM(STR(YEAR(DATE())))
b_month=ALLTRIM(STR(MONTH(DATE())))
b_day=ALLTRIM(STR(day(DATE())))
IF LEN(b_month)=1 then
   b_month="0"+b_month
ENDIF
IF LEN(b_day)=1 then
   b_day="0"+b_day
ENDIF
rq=b_year+b_month+b_day+SUBSTR(TIME(),1,2)
ml=SYS(5)+SYS(2003)
ml=ml+"\DATA"
IF  !directory("&ml") then
RUN MD DATA
ENDIF
xlsdoc=SYS(5)+SYS(2003)+"\DATA\"+rq+".xls"
IF FILE("&xlsdoc") then
   DELETE FILE &xlsdoc
ENDIF
ef=CREATEOBJECT('Excel.application')
if .not. ( type('ef')='O' ) 
    =messagebox( '创 建 报 表 失 败！' + CHR(13) + CHR(13) + ;
                 '请检查你的系统是否正确安装 EXCEL 软件！' + CHR(13) + CHR(13) + ;
                 '请联络系统管理员……' + CHR(13), 48, '')
    return
ENDIF
IF njxz="1" then
   btitle="高一年级各班"+ALLTRIM(STR(MONTH(DATE())))+"月月考成绩表"
ENDIF
IF njxz="2" then
   btitle="高二年级各班"+ALLTRIM(STR(MONTH(DATE())))+"月月考成绩表"
ENDIF
IF njxz="3" then
   btitle="高三年级各班"+ALLTRIM(STR(MONTH(DATE())))+"月月考成绩表"
ENDIF
=messagebox( '准备生成' +btitle+ CHR(13) + CHR(13) +'日期：' + ALLTRIM(STR(YEAR(DATE()))) +"年"+ ALLTRIM(STR(month(DATE())))+"月";
+ALLTRIM(STR(day(DATE())))+"日"+ CHR(13) + CHR(13) + '如有在使用 EXCEL ,请暂时不要使用打印预览功能！！！' + CHR(13) + CHR(13) + ;
'报表生成的过程中，请暂时不要使用计算机！！！', 48, "")

wait '正在生成'+btitle+'，请稍侯....已完成----  0%'  WINDOW AT wz2,wz1 nowait
ef.visible=.f.
ef.DisplayRecentFiles = .f.
ef.SheetsInNewWorkbook = 1
ef.quit
RELEASE ef
sj=TIME()
ef=CREATEOBJECT('Excel.application')
ef.Workbooks.add
ef.activeWorkbook.saveas(xlsdoc)
ef.visible=.f.
ef.CommandBars("Standard").Visible = .f.
ef.CommandBars("Formatting").Visible = .f.
ef.DisplayFormulaBar = .f.
ef.DisplayStatusBar = .f.
ef.CommandBars("Visual Basic").Visible = .f.
ef.CommandBars("Web").Visible = .f.
ef.CommandBars("Forms").Visible = .f.
ef.CommandBars("Drawing").Visible = .f.
ef.CommandBars("Control Toolbox").Visible = .f.
ef.CommandBars("Reviewing").Visible = .f.
ef.CommandBars("PivotTable").Visible = .f.
ef.CommandBars("Stop Recording").Visible = .f.
ef.CommandBars("Chart").Visible = .f.
ef.CommandBars("Picture").Visible = .f.
ef.CommandBars("External Data").Visible = .f.
ef.CommandBars("WordArt").Visible = .f.
ef.ShowWindowsInTaskbar = .t.
ef.activewindow.WindowState =2
&&ef.commandbars(1).enabled=.f.
ef.caption=btitle
SELECT 1
USE class.dbf EXCLUSIVE
COPY TO classbak.dbf FOR SUBSTR(ALLTRIM(班级代码),1,1)=njxz
USE classbak.dbf EXCLUSIVE
SORT TO bakclass.dbf ON 班级代码 DESCENDING 
USE bakclass.dbf EXCLUSIVE
DELETE FILE classbak.*
xhcs=RECCOUNT()
GO 1
p_bjmc=ALLTRIM(班级名称)
p_bjdm=ALLTRIM(班级代码)
p_kblb=ALLTRIM(STR(开课类别),1)
p_wldm=ALLTRIM(文理代码)
cs=2
DO WHILE cs<=xhcs
   ef.sheets.add
   cs=cs+1
ENDDO
USE bakclass.dbf EXCLUSIVE
SORT TO classbak.dbf ON 班级代码 ASCENDING 
USE classbak.dbf EXCLUSIVE
DELETE FILE bakclass.*
p_bjmc=ALLTRIM(班级名称)
p_bjdm=ALLTRIM(班级代码)
p_kblb=ALLTRIM(STR(开课类别),1)
p_wldm=ALLTRIM(文理代码)
cs=xhcs
SJ1=TIME()
BFL=0
BFL1="  0%"
bfl2=bfl1
DO WHILE (cs<=xhcs).and.(cs>=1)
 dh="sheet"+ALLTRIM(STR(cs))
 ef.Worksheets("&dh").Activate
 ef.Worksheets("&dh").name=p_bjmc
 ef.Cells.Select
 ef.Selection.Font.Size = 9
 SELECT 2
 USE tablegrade.dbf EXCLUSIVE
 COUNT TO MAXRS FOR SUBSTR(编号,1,1)=NJXZ
 COPY TO bak.dbf FOR (SUBSTR(编号,1,1)+SUBSTR(编号,5,2))=ALLTRIM(p_bjdm)
 USE bak.dbf EXCLUSIVE
 SORT TO temp.dbf ON 总分 DESCENDING 
 USE temp EXCLUSIVE
 DELETE FILE bak.*
 DO mk WITH p_kblb
 p_bjrs=reccount()
 sx=FCOUNT()
 hx=p_bjrs
 sx1=1
 num=INT((p_bjrs+1)/2)
 go top
 hx1=1
 do while hx1<=sx
  bl=field(hx1)
  IF bl="班名" then
     ef.cells(3,hx1).value="班"
     ef.cells(4,hx1).value="名"
     ef.cells(3,hx1).borders(1).weight=2
     ef.cells(3,hx1).borders(2).weight=2
     ef.cells(3,hx1).borders(3).weight=2
     ef.cells(3,hx1).borders(1).LineStyle=1
     ef.cells(3,hx1).borders(2).LineStyle=1
     ef.cells(3,hx1).borders(3).LineStyle=1
     ef.cells(4,hx1).borders(1).weight=2
     ef.cells(4,hx1).borders(2).weight=2
     ef.cells(4,hx1).borders(4).weight=2
     ef.cells(4,hx1).borders(1).LineStyle=1
     ef.cells(4,hx1).borders(2).LineStyle=1
     ef.cells(4,hx1).borders(4).LineStyle=1
    ELSE
     zm=CHR(64+hx1)
     zm1=zm+"3"
     zm2=zm+"4"
     ef.range("&zm1:&zm2").select
     ef.selection.merge
     ef.selection.borders(1).weight=2
     ef.selection.borders(2).weight=2
     ef.selection.borders(3).weight=2
     ef.selection.borders(4).weight=2
     ef.selection.borders(1).LineStyle=1
     ef.selection.borders(2).LineStyle=1
     ef.selection.borders(3).LineStyle=1
     ef.selection.borders(4).LineStyle=1
     ef.cells(3,hx1).value=bl
  ENDIF
  IF hx1=1 THEN 
    ef.Columns(1).ColumnWidth=4.38
   ELSE
    ef.Columns(hx1).ColumnWidth=2.88
  endif 
  IF (ef.cells(3,hx1).value="班") .and. ef.cells(4,hx1).value="名" then
      ef.Columns(hx1).ColumnWidth=1.5
  endif   
  ef.Rows("3:4").HorizontalAlignment = 3
  ef.Rows("3:4").VerticalAlignment = 2
  hx1=hx1+1
 ENDDO
 hx1=1
 ef.Columns(KCS+1).ColumnWidth=0.2
 do while hx1<=sx
  bl=field(hx1)
  IF bl="班名" then
     ef.cells(3,hx1+kcs+1).value="班"
     ef.cells(4,hx1+kcs+1).value="名"
     ef.cells(3,hx1+kcs+1).borders(1).weight=2
     ef.cells(3,hx1+kcs+1).borders(2).weight=2
     ef.cells(3,hx1+kcs+1).borders(3).weight=2
     ef.cells(3,hx1+kcs+1).borders(1).LineStyle=1
     ef.cells(3,hx1+kcs+1).borders(2).LineStyle=1
     ef.cells(3,hx1+kcs+1).borders(3).LineStyle=1
     ef.cells(4,hx1+kcs+1).borders(1).weight=2
     ef.cells(4,hx1+kcs+1).borders(2).weight=2
     ef.cells(4,hx1+kcs+1).borders(4).weight=2
     ef.cells(4,hx1+kcs+1).borders(1).LineStyle=1
     ef.cells(4,hx1+kcs+1).borders(2).LineStyle=1
     ef.cells(4,hx1+kcs+1).borders(4).LineStyle=1
    ELSE
    zm=CHR(64+hx1+kcs+1)
    zm1=zm+"3"
    zm2=zm+"4"
    ef.range("&zm1:&zm2").select
    ef.selection.merge
    ef.selection.borders(1).weight=2
    ef.selection.borders(2).weight=2
    ef.selection.borders(3).weight=2
    ef.selection.borders(4).weight=2
    ef.selection.borders(1).LineStyle=1
    ef.selection.borders(2).LineStyle=1
    ef.selection.borders(3).LineStyle=1
    ef.selection.borders(4).LineStyle=1
    ef.cells(3,hx1+kcs+1).value=bl
  ENDIF
  IF hx1=1 THEN 
    ef.Columns(kcs+2).ColumnWidth=4.38
   ELSE
    ef.Columns(hx1+kcs+1).ColumnWidth=2.88
  endif 
  IF (ef.cells(3,hx1+kcs+1).value="班") .and. ef.cells(4,hx1+kcs+1).value="名" then
      ef.Columns(hx1+kcs+1).ColumnWidth=1.5
  endif   
  ef.Rows("3:4").HorizontalAlignment = 3
  ef.Rows("3:4").VerticalAlignment = 2
  hx1=hx1+1
 ENDDO
 sx1=1
 p_bjrs=reccount()
 num=INT((p_bjrs+1)/2)
 do while sx1<num+1
   hx1=1
   do while hx1<=sx
     bl=field(hx1)
     ef.cells(sx1+4,hx1).value=&bl
     hx1=hx1+1
   ENDDO
   SKIP 1
   BFL=BFL+1
     BFL1=SUBSTR(ALLTRIM(STR(INT(BFL/MAXRS*100))),1,2)
     IF LEN(bfl1)=1 THEN 
        bfl1="  "+bfl1+"%"
       ELSE
        bfl1=" "+bfl1+"%" 
     endif   
     IF BFL=MAXRS THEN
        BFL1="100%"
     ENDIF
     IF bfl1<>bfl2 THEN 
        wait '正在生成'+btitle+'，请稍侯...已完成----'+BFL1  WINDOW AT wz2,wz1 nowait
        bfl2=bfl1
     ENDIF
     sx1=sx1+1
 ENDDO
 IF (kcs+1)>26 then
    zm="AB"
  ELSE
    zm=CHR(64+kcs)
 ENDIF
 bh=ALLTRIM(STR(num+4))
 zm2=zm+bh
 ef.range("A5:&zm2").select
 ef.selection.borders(1).weight=2
 ef.selection.borders(2).weight=2
 ef.selection.borders(3).weight=2
 ef.selection.borders(4).weight=2
 ef.selection.borders(1).LineStyle=1
 ef.selection.borders(2).LineStyle=1
 ef.selection.borders(3).LineStyle=1
 ef.selection.borders(4).LineStyle=1
 sx1=1
 do while sx1<(p_bjrs-num)+1
   hx1=1
   do while hx1<=sx
     bl=field(hx1)
     ef.cells(sx1+4,hx1+kcs+1).value=&bl
     hx1=hx1+1
   ENDDO
   SKIP 1
   BFL=BFL+1
     BFL1=SUBSTR(ALLTRIM(STR(INT(BFL/MAXRS*100))),1,2)
     IF LEN(bfl1)=1 THEN 
        bfl1="  "+bfl1+"%"
       ELSE
        bfl1=" "+bfl1+"%" 
     endif   
     IF BFL=MAXRS THEN
        BFL1="100%"
     ENDIF
     IF bfl1<>bfl2 THEN 
        wait '正在生成'+btitle+'，请稍侯...已完成----'+BFL1  WINDOW AT wz2,wz1 nowait
        bfl2=bfl1
     ENDIF
     IF EOF() then
      EXIT
   ENDIF
   sx1=sx1+1
 ENDDO
 zm1=CHR(65+kcs+1)+"5"
 IF ((kcs*2+1)>26).and.((kcs*2-25)<26) then
    zm="A"+CHR(39+kcs*2)
  ELSE
    zm=CHR(65+kcs*2)
 ENDIF
 bh=ALLTRIM(STR(num+4))
 zm2=zm+bh
 ef.range("&zm1:&zm2").select
 ef.selection.borders(1).weight=2
 ef.selection.borders(2).weight=2
 ef.selection.borders(3).weight=2
 ef.selection.borders(4).weight=2
 ef.selection.borders(1).LineStyle=1
 ef.selection.borders(2).LineStyle=1
 ef.selection.borders(3).LineStyle=1
 ef.selection.borders(4).LineStyle=1
 ef.ActiveSheet.PageSetup.LeftMargin=1/0.035
 ef.ActiveSheet.PageSetup.RightMargin=1/0.035
 ef.ActiveSheet.PageSetup.TopMargin=1/0.035
 ef.ActiveSheet.PageSetup.BottomMargin=1/0.035
 ef.ActiveSheet.PageSetup.HeaderMargin=1/0.035
 ef.ActiveSheet.PageSetup.FooterMargin=1/0.035
 ef.ActiveSheet.PageSetup.Orientation=1
 ef.ActiveSheet.PageSetup.CenterHorizontally=.t.
 ef.ActiveSheet.PageSetup.CenterVertically=.t.
 &&ef.ActiveSheet.PrintPreview
 SELECT 1
 SKIP
 IF EOF() THEN 
    EXIT
 ENDIF
 cs=cs-1
 p_bjmc=ALLTRIM(班级名称)
 p_bjdm=ALLTRIM(班级代码)
 p_kblb=ALLTRIM(STR(开课类别),1)
 p_wldm=ALLTRIM(文理代码)
ENDDO
CLOSE ALL
DELETE FILE bak.*
DELETE FILE temp.*
DELETE FILE classbak.*
ef.activeWorkbook.Save
ef.activeWorkbook.close(.f.)
ef.quit
ef=NULL
release ef
ef=CREATEOBJECT('Excel.application')
ef.Workbooks.add
ef.visible=.f.
ef.commandbars(1).enabled=.t. 
ef.CommandBars("Standard").Visible = .t.
ef.CommandBars("Formatting").Visible = .t.
ef.DisplayAlerts = .T.
ef.DisplayRecentFiles = .t.
ef.SheetsInNewWorkbook = 3
ef.DisplayFormulaBar = .t.
ef.DisplayStatusBar = .t.
ef.ShowWindowsInTaskbar = .t.
ef.activeWorkbook.close
ef.quit
ef=NULL
release ef 
CLOSE ALL