分享

将VFP的DBF导出到WORD(可以打印任意字段内容)

 王咸美 2013-08-02
* 编号:A0019
* 功能:将VFP的DBF导出到WORD
* 说明:通用型字段内容用Gen表示、备注型字段内容用Memo表示

SET TALK OFF
SET SAFETY OFF
SET DATE TO YMD
SET MARK TO "-"
SET CENTURY ON
SET COMPATIBLE OFF

LOCAL my_title,my_alias
SET PATH TO D:\表
my_alias="档案"
my_title= " "
my_dbfopen=.F.
IF EMPTY(my_alias)
RETURN
ENDIF

IF !USED(my_alias)
USE &my_alias IN 0
ELSE
SELECT (my_alias)
my_dbfopen=.T.
ENDIF
SELECT(my_alias)
IF EOF()
GO TOP
IF EOF()
IF my_dbfopen=.F.
SELECT(my_alias)
USE
ENDIF
RETURN
ENDIF
ENDIF
IF EMPTY(ALLTRIM(my_title))
my_title=my_alias
ENDIF
WAIT "正在访问 Word 软件……" WINDOW NOWAIT
WordApp=CREATEOBJECT("Word.application")   &&访问WORD
If Type("WordApp")#"O"
WAIT CLEAR
MessageBox( "访问Word失败!请检查你的系统是否正确安装 Word 软件!",48,"没有安装Word")
RETURN
ENDIF
WAIT "正在生成表格……" WINDOW NOWAIT
WordApp.Visible =.T.
WordApp.Documents.Add
*WordApp.ActiveDocument.PageSetup.PageWidth=18.4/0.035  &&设置页宽
*WordApp.ActiveDocument.PageSetup.PageHeight=26/0.035   &&设置页高
WordApp.ActiveDocument.PageSetup.LinesPage = 35         &&设置每页打印行数
WordApp.Documents(1).Range.Text=ALIAS()+"一览表"
WordApp.Documents(1).Range.Font.Size= 15
WordApp.Documents(1).Range.Font.Name="黑体"
WordApp.Documents(1).Range.Paragraphs.Alignment= 1

#define NUM_AFIELDS 16
PUBLIC aWizFList
DIMENSION aWizFList[1]
=AFIELDS(aWizFList)

LOCAL  mytextzhi
SELECT(my_alias)
GO top
myfcount=fcount()
WordAppRang=WordApp.Documents(1).Range(LENC(WordApp.Documents(1).Range.Text)-1,LENC(WordApp.Documents(1).Range.Text)-1)
WordTable=WordApp.Documents(1).Tables.Add(WordAppRang,RECCOUNT()+1,myfcount)
WordTable.Range.Paragraphs.Alignment= 0
WordTable.Range.Font.Name="宋体"
WordTable.Range.Font.Size=10
WordTable.Borders.Enable=1
WordTable.Borders(1).LineWidth = 12
WordTable.Borders(2).LineWidth = 12
WordTable.Borders(3).LineWidth = 12
WordTable.Borders(4).LineWidth = 12
WordTable.Rows(1).Borders(3).LineWidth = 12
WordTable.Rows(1).Range.Font.Bold=.t.
WordTable.Rows(1).Cells.VerticalAlignment= 1
WordTable.Rows(1).Range.Paragraphs.Alignment = 4    && 分散对齐
WordTable.Rows(1).HeadingFormat=.t.
 
FOR j=1 to RECCOUNT()
FOR i=1 to fcount()
  if INLIST(aWizFList[i,2],"G")
    WordTable.Cell(1,i).Range.Text=field(i)
    WordTable.Rows(j+1).Cells(i).Range.Text="Gen"
 else
   if INLIST(aWizFList[i,2],"M")
    WordTable.Cell(1,i).Range.Text=field(i)
    WordTable.Rows(j+1).Cells(i).Range.Text="Memo"
   else
    myzdm=aWizFList[i,1]
    mytextzhi=EVALUATE(myzdm)
    IF EMPTY(mytextzhi) OR ISNULL(mytextzhi)
       mytextzhi="  "
    ELSE
      DO CASE
        CASE INLIST(aWizFList[i,2],"C")
          mytextzhi=ALLTRIM(mytextzhi)
        CASE INLIST(aWizFList[i,2],"M")
          mytextzhi=TRIM(mytextzhi)
          mytextzhi=STRTRAN(mytextzhi,CHR(13),' ')
        CASE INLIST(aWizFList[i,2],"N")
          mywidth=aWizFList[i,3]
          mydwidth=aWizFList[i,4]
          mytextzhi=allt(STR(mytextzhi,mywidth,mydwidth))
        CASE INLIST(aWizFList[i,2],"Y")
          mytextzhi=ALLTRIM(STR(mytextzhi,20,4))
        CASE INLIST(aWizFList[i,2],"I","B","F")
          mytextzhi=ALLTRIM(STR(mytextzhi))
        CASE aWizFList[i,2]="D"
          mytextzhi=DTOC(mytextzhi)
        CASE aWizFList[i,2]="T"
          mytextzhi=TTOC(mytextzhi)
        CASE aWizFList[i,2]="L"
          IF mytextzhi=.T.
            mytextzhi="是"
          ELSE
            mytextzhi="否"
         ENDIF
       OTHER= "    "
     ENDCASE
     IF EMPTY(mytextzhi) OR ISNULL("mytextzhi")
        mytextzhi="   "
     ENDIF
     WordTable.Cell(1,i-k).Range.Text = aWizFList[i,1]
     WordTable.rows(j+1).cells(i-k).Range.InsertAfter(mytextzhi)
  ENDIF
 endif
endif
NEXT i
  SKIP 1
NEXT j   
WordTable.Columns().AutoFit

* 下面为页面设置
WordApp.ActiveDocument.PageSetup.PaperSize=7
WordApp.ActiveDocument.PageSetup.Orientation=0 &&页面竖放 0-竖放  1-横放
*WordTable.Rows.HorizontalPosition=-999995              &&表格水平居中
WordApp.ActiveDocument.PageSetup.TopMargin=22.0*2.835  &&设置上边距
WordApp.ActiveDocument.PageSetup.BottomMargin=22.0*2.835  &&设置下边距
WordApp.ActiveDocument.PageSetup.LeftMargin=19.0*2.835     &&设置左边距
WordApp.ActiveDocument.PageSetup.RightMargin=19.0*2.835    &&设置右边距
WordApp.ActiveDocument.PageSetup.VerticalAlignment=0       &&页面对齐方;式 0-上  1-中  2-下
WordApp.ActiveDocument.PageSetup.HeaderDistance=22.0*2.835  &&页眉位置
WordApp.ActiveDocument.PageSetup.FooterDistance=19.0*2.835   &&页脚位置
mydate=subst(dtos(date()),1,4)+"年"+subst(dtos(date()),5,2)+;
"月"+subst(dtos(date()),7,2)+"日"
WordApp.Documents(1).Sections(1).Headers(1).Range.Text="制表期: ;
"+mydate+" "         &&页眉
WordApp.Documents(1).Sections(1).Headers(1).Range.Paragraphs.Alignment=2               &&页眉右齐
WordApp.Documents(1).Sections(1).Footers(1).Range.Paragraphs.Alignment= 2              &&页脚居中
WordApp.Documents(1).Sections(1).Footers(1).Range.Select
WordApp.Selection.InsertAfter("第")
WordApp.Selection.Start =WordApp.Selection.End
WordApp.Selection.InsertFormula("PAGE")
WordApp.Selection.Start =WordApp.Selection.End
WordApp.Selection.InsertBefore("页/共")
WordApp.Selection.Start =WordApp.Selection.End
WordApp.Selection.InsertFormula("NUMPAGES")
WordApp.Selection.Start =WordApp.Selection.End
WordApp.Selection.InsertBefore("页")
WordApp.Selection.Range.Paragraphs.Alignment= 1
WordTable.Rows(1).HeadingFormat=.t.
WordTable.Columns().AutoFit                         &&自动调整列宽                 
WordApp.Documents(1).SaveAs("E:\"+my_title+".doc")    &&自动保存文件
RELEASE WordApp
WAIT CLEAR
MessageBox( "生成Word文件完毕,文件位置E:\"+my_title+".doc!",64,"完毕")
RETURN

    本站是提供个人知识管理的网络存储空间,所有内容均由用户发布,不代表本站观点。请注意甄别内容中的联系方式、诱导购买等信息,谨防诈骗。如发现有害或侵权内容,请点击一键举报。
    转藏 分享 献花(0

    0条评论

    发表

    请遵守用户 评论公约