注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

宝贝小屋

生活 工作 学习

 
 
 

日志

 
 

VFP全面控制EXCEL  

2010-12-19 10:26:10|  分类: 默认分类 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |

VFP和Excel都可以用来进行处理数据库表格,如果巧妙地将二者的优点结合起来,将会大大方便我们的工作。比如我们可以利用VFP进行处理数据,而利用Excel的预览打印功能进行报表打印。这就需要我们在VFP中直接来控制Excel。下面就在开发VFP应用项目时对Excel的控制作一下介绍:


*!* 1.创建Excel对象
oExcel=Createobject("Excel.application")


*!* 2.添加新工作簿
oExcel.Workbooks.Add
 

*!* 3.设置第3个工作表为激活工作表
oExcel.Worksheets("sheet3").Activate
 

*!* 4.打开指定工作簿
oExcel.Workbooks.Open("c:\temp\ll.xls")
 

*!* 5.显示Excel窗口
oExcel.Visible=.T.
 

*!* 6.更改Excel标题栏
oExcel.Caption="VFP应用程序调用Microsoft Excel"
 

*!* 7.给单元格赋值
oExcel.cells(1,4).Value=XM(XM为数据库字段名)
 

*!* 8.设置指定列的宽度(单位:字符个数)
oExcel.ActiveSheet.Columns(1).ColumnWidth=5
 

*!* 9.设置指定行的高度(单位:磅)
oExcel.ActiveSheet.Rows(1).RowHeight=1
(设定行高为1磅,1磅=0.035厘米)
oExcel.ActiveSheet.Rows("50:100").RowHeight=1 &&设置第50行至100行的高度
 

*!* 10.在第18行之前插入分页符
oExcel.Worksheets("Sheet1").Rows(18).PageBreak=1
 

*!* 11.在第4列之前删除分页符
oExcel.ActiveSheet.Columns(4).PageBreak=0
 

*!* 12.指定边框线宽度(Borders参数如下)
ole.ActiveSheet.Range("b3:d3").BorderS(2).Weight=3
 

*!* 13.设置四个边框线条的类型
oExcel.ActiveSheet.Range("b3:d3").BorderS(2).LineStyle=1
(其中Borders参数:1-左、2-右、3-顶、4-底、5-斜、6-斜/;LineStyle值:1与7-细实、2-细虚、4-点虚、9-双细实线)
 

*!* 14.设置页眉
oExcel.ActiveSheet.PageSetup.CenterHeader="报表1"
 

*!* 15.设置页眉(字体大小)
oExcel.ActiveSheet.PageSetup.CenterHeader="&50报表1" &&'&'后面的50可以自定义,表示字体的大小
 

*!* 16.设置页脚
oExcel.ActiveSheet.PageSetup.CenterFooter="第&P页"
 

*!* 17.设置页脚(字体大小)
oExcel.ActiveSheet.PageSetup.CenterFooter="&28第&P页" &&'&'后面的28可以自定义,表示字体的大小
 

*!* 18.设置页眉到顶端边距为2厘米
oExcel.ActiveSheet.PageSetup.HeaderMargin=2/0.035
 

*!* 19.设置页脚到底边距为3厘米
oExcel.ActiveSheet.PageSetup.FooterMargin=3/0.035
 

*!* 20.设置顶边距为2厘米
oExcel.ActiveSheet.PageSetup.TopMargin=2/0.035
 

*!* 21.设置底边距为4厘米
oExcel.ActiveSheet.PageSetup.BottomMargin=4/0.035
 

*!* 22.设置左边距为2厘米
oExcel.ActiveSheet.PageSetup.LeftMargin=2/0.035
 

*!* 23.设置右边距为2厘米
oExcel.ActiveSheet.PageSetup.RightMargin=2/0.035
 

*!* 24.设置页面水平居中
oExcel.ActiveSheet.PageSetup.CenterHorizontally=.T.
 

*!* 25.设置页面垂直居中
oExcel.ActiveSheet.PageSetup.CenterVertically=.T.
 

*!* 26.设置页面纸张大小(1-窄行8511 39-宽行1411 9:A4)
oExcel.ActiveSheet.PageSetup.Papersize=1
 

*!* 27.打印单元格网线
oExcel.ActiveSheet.PageSetup.PrintGridlines=.T.
 

*!* 28.拷贝整个工作表
oExcel.ActiveSheet.UsedRange.Copy
 

*!* 29.拷贝指定区域
oExcel.ActiveSheet.Range("A1:E2").Copy
 

*!* 30.粘贴
oExcel.WorkSheet("Sheet2").Range("A1").PasteSpecial
 

*!* 31.在第2行之前插入一行
oExcel.ActiveSheet.Rows(2).Insert
 

*!* 32.在第2列之前插入一列
oExcel.ActiveSheet.Columns(2).Insert
 

*!* 33.设置字体
oExcel.ActiveSheet.Cells(2,1).Font.Name="黑体"
 

*!* 34.设置字体大小
oExcel.ActiveSheet.Cells(1,1).Font.Size=25
 

*!* 35.设置字体为斜体
oExcel.ActiveSheet.Cells(1,1).Font.Italic=.T.
 

*!* 36.设置整列字体为粗体
oExcel.ActiveSheet.Columns(1).Font.Bold=.T.
 

*!* 37.清除单元格公式
oExcel.ActiveSheet.Cells(1,4).ClearContents
 

*!* 38.打印预览工作表
oExcel.ActiveSheet.PrintPreview
 

*!* 39.打印输出工作表
oExcel.ActiveSheet.PrintOut
 

*!* 40. oExcel.CommandBars(1).Controls(1).accChild(18).Execute &&打印(菜单序号18为Excel2003的‘打印’项)
&&不同版本Excel的菜单序号可以通过以下程序取得
*(需要在VFP7.0以上运行)
oXls=Getobject("","excel.sheet")
XlApp=oXLS.Application
XlSheet=XlApp.ActiveSheet
bars=xlapp.CommandBars.Count
Str1=''
For i=1 To bars
    Str1=Str1+Chr(13)+Alltrim(Str(i))+'、'+xlapp.CommandBars(i).accName+'(NAME:'+xlapp.CommandBars(i).Name+' INDEX:'+Alltrim(Str(xlapp.CommandBars(i).Index))+')'
    bars2=xlapp.commandbars(i).accChildCount
    For j=1 To bars2
        Try
            obj=xlapp.commandbars(i).Controls(j)
            Str1=Str1+Chr(13)+' '+Alltrim(Str(j))+'、'+xlapp.commandbars(i).Controls(j).accname+'(ID:'+Alltrim(Str(xlapp.CommandBars(i).Controls(j).Id))+')'
            For k=1 To obj.accChildCount
                Try
                    If Not Empty(obj.Controls(k).accname )
                        Str1=Str1+Chr(13)+' '+Alltrim(Str(k))+'、'+obj.Controls(k).accName+' (ID:'+ Alltrim(Str(obj.Controls(k).Id))+')'
                    Endif
                Catch
                    Exit
                Endtry
            Endfor
        Catch
            Exit
        Endtry
    Endfor
    Wait Windows Alltrim(Str(i))+' / '+Alltrim(Str(bars))+' '+Str(i/bars*100,10,2)+'%' Nowait
Endfor
Save To Xls.txt All Like Str1
Modify Command Xls.txt
Return
 

*!* 41.工作表另存为
oExcel.ActiveWorkbook.SaveAs("c:\temp\22.xls")
*检测当前目录是否有同名的EXCEL表,如果有先删除,再另存
If !File(Sys(5) + Curdir() + "result.xls")
    oExcel.ActiveWorkbook.SaveAs(Sys(5) + Curdir() + "result.xls")
Else
    lcFileName = loExcel.GetSaveAsFilename("result", "Excel (*.xls), *.xls")
    If !Empty(lcFileName)
        If File(lcFileName)
            Delete File (lcFileName)
        Endif
        oExcel.ActiveWorkbook.SaveAs(lcFileName)
    Endif
Endif
*!* 42.放弃存盘 && 避免出现保存对话框
oExcel.ActiveWorkbook.saved=.T.
 

*!* 43.存盘
oExcel.ActiveWorkbook.Save
 

*!* 44.关闭工作簿
oExcel.Workbooks.Close
objexcel.activeworkbook.Close(.F.)
 

*!* 45.退出Excel
oExcel.Quit
Release oExcel &&只有释放对象变量, EXCEL进程才会完全关闭
 

*!* 46.合并单元格
oExcel.ActiveSheet.Range("A4:B5").MergeCells=.T.
 

*!* 47.下列设置大家自己理解
With crfole.ActiveSheet.PageSetup
    .LeftHeader = Chr(13)+"左页眉"
    .CenterHeader = "中页眉"
    .RightHeader = "右页眉"
    .LeftFooter = "左页脚"
    .CenterFooter = "中页脚"
    .RightFooter = "右页脚"
    .Orientation=1 &&1竖排,2横排
Endwith
With crfole.Range("A4:C4")
    .MergeCells = .T.
    .WrapText =.F.
    .Orientation = 0
    .AddIndent =.F.
    .ShrinkToFit = .F.
Endwith
 

*!* 48.文本对齐
oExcel.Range("A4:c4").HorizontalAlignment =1 &&水平(1-默认、2-靠左、3-居中、4-靠右、5-填充、6=两端对齐、7=跨列居中、8=分散对齐)
oExcel.Range("A4:c4").VerticalAlignment =2 &&垂直(1=靠上、2=居中、3=靠下、4=两端对齐、5=分散对齐)
 

*!* 49.拷贝整个工作表(含格式)
oExcel.activesheet.cells.Copy &&拷贝
oExcel.sheets(1).Select &&选择第一工作表
oExcel.ActiveSheet.Paste &&粘贴
oExcel.ActiveSheet.Cells(3,4).Value && ActiveSheet 为当前的Sheet工作薄名字,Cells(3,4).value 为第3行第4列的值
*以上控制调用语句在中文VFP5.0企业版下运行通过,运行环境为Excel 97及中文Windows 98
 

*!* 50.显示某个单元格的批注内容
oExcel=Createobject("Excel.application")
oExcel.Workbooks.Open("d:\TEST\testa.xls")
oExcel.Visible=.T.
?oExcel.Range("B5").Comment.Text &&显示B5单元格的批注内容
oExcel.Workbooks.Close
oExcel.Quit
Release oExcel
 

*!* 51.oExcel.ActiveSheet.PageSetup.PrintTitleRows="$1:$1" &&每页都打印行标头(每页顶部出现的单元格的行)
 

*!* 52.保护工作表:
oExcel.ActiveSheet.Protect('密码',.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.,.T.)
 

*!* 53.保护工作薄
oExcel.ActiveWorkbook.Protect('密码',.T.,.T.)
第一个.T.:保护工作簿结构
第二个.T.:保护工作簿窗口
 

*!* 54.设置允许用户编辑区域
oExcel.ActiveSheet.Protection.AllowEditRanges.Add("区域3",oExcel.ActiveSheet.Range("A2:D5"))
 

*!* 55.如果不想在宏运行时被无穷无尽的提示和警告消息所困扰,就将本属性设置为.F.
oExcel.DisplayAlerts = .F.
如果不想在宏运行时被无穷无尽的提示和警告消息所困扰,就将本属性设置为 False;这样每次出现需用户应答的消息时,Microsoft Excel 将选择默认应答。
如果将本属性设置为 False,那么宏运行结束后, Microsoft Excel 并不自动将其设置回 True。故当宏运行结束后,都应将本属性设置回 True 值。
 

*!* 56.将当前工作表中的已用区域(只读)存入数组。
strPath='D:\TEST\123.xls'
Local oExcel
oExcel=Createobject("Excel.Application")
oExcel.WorkBooks.Open(strPath)
arrTableInfo=oExcel.ActiveSheet.UsedRange.Value &&将当前工作表中的已用区域(只读)存入数组。
oExcel.Quit
Release oExcel
Insert Into 表名 From arrTableInfo
 

*!* 57.设置excel批注的字体(excel 2000实现了,如下:)
ole.Range("a3").Comment.Shape.Select && 此命令要求批注的 Visible=.t.
ole.Selection.Font.Size=9
ole.Selection.Font.Name="黑体"
ole.Selection.Font.bold=.F.
注:该组命令要求先选中批注框,否则写成 ole.Range("a3").Comment.Shape.Font.Size=9 则出错,不知为何!
 

*!* 58.如何取得当前EXCEL表中工作表的数目及各工作表的名称?
Clear
Local lnSheetCount
oExcel=Createobject("EXCEL.APPLICATION") &&创建Excel对象
oExcel.WORKBOOKS.Open("c:\111\321.xls") &&打开指定工作簿
With oExcel
    lnSheetCount=.WorkBooks(1).Sheets.Count &&统计工作表数量
Endwith
?'当前EXCEL表中工作表的数目为:'+Alltrim(Str(lnSheetCount))
For Each oMyVar In oExcel.sheets
    ?'当前EXCEL表中工作表的名称分别为'+oMyVar.Name &&显示Excel表中所有工作表
Next oMyVar
oExcel.WORKBOOKS.Close &&关闭工作簿
oExcel.Quit &&退出Excel
 

*!* 59.获取工作表名称
在以下示例中,创建了一个 microsoft excel 实例,添加了一个新的工作簿。使用 foreach 语句显示工作簿中每个工作表的名称。此示例要求在运行示例的机器上正确安装 microsoft excel。
oExcel = Create("Excel.Application")
oExcel.Workbooks.Add
For Each oMyVar In oExcel.sheets
    ? oMyVar.Name
Next oMyVar
 

*!* 60.虽然用APPEND From tx.Xls Type XL8可以更简单的追加数据,但有时会导致程序非法错误退出(除非先另存为Excel 5.0)
 

*!* 61.VFP控制EXCL文件另存为DBF(EXCEL后台运行)
fil=Thisform.List1.Value &&其值为一个包含路径的文件名
oExcel=Createobject('Excel.application')
oExcel.Workbooks.Open(fil) &&打开文件
oExcel.Selection.AutoFilter &&关闭(如果无则打开)自动筛选
oExcel.Range("A1:F1000").Select &&选中从第1行到1000行的前6列数据(另存后只有这些数据)
asfil=Strtran(Upper(Strtran(fil,Substr(fil,1,Rat('\',fil)),'c:\windows\desktop\cphz\')),'.XLS','.dbf') &&要保存的文件名
If File(asfil)
    Delete File &asfil
Endif
oExcel.ActiveWorkbook.SaveAs(asfil,8) &&另存为DBF
oExcel.ActiveWorkbook.saved=.T. &&不保存当前EXCEL表
oExcel.Workbooks.Close &&关闭表
oExcel.Quit &&退出EXCEL
Release oExcel &&释放变量
*************VFP中例子******************
lcFileName='D:\TEST.XLS'
oExcel=Createobject('Excel.application')
oExcel.Workbooks.Open('&lcFileName') &&打开文件
R=oExcel.SHEETS(1).UsedRange.Rows.Count &&有数据的总行数
C=oExcel.SHEETS(1).UsedRange.Columns.Count &&有数据的总列数
oExcel.Cells(R,C).Select &&选中数据
oExcel.Selection.NumberFormatLocal = "@" &&把被选定的单元格设为文本格式
oExcel.Columns.AutoFit &&让所有的列宽都自动调整
oExcel.DisplayAlerts=.F.
oExcel.ActiveWorkbook.SaveAs('D:\TEST.DBF',8) &&另存为DBF
*oExcel.ActiveWorkbook.SaveAs('D:\NewTest.xls',39) &&另存为5.0的Excel,或用43表示95/97格式
oExcel.ActiveWorkbook.saved=.T. &&不保存当前EXCEL表
oExcel.Workbooks.Close &&关闭表
oExcel.Quit &&退出EXCEL
Release oExcel &&释放变量
Messagebox('Excel文件:D:\TEST.XLS 另存为 D:\TEST.DBF 完成!',64,'信息提示')
***********VB例子*************
'功能:VB调用Excel,将一个Excel文件另存为Dbf。'
'前提:要安装Excel'
Dim oExcel As Object
lcSFileName = "D:\test.xls" '源Excel文件名
lcDFileName = "D:\test1.dbf" '目标Dbf文件名
Set oExcel = Createobject("Excel.Application") '创建Excel对象
oExcel.Workbooks.Open (lcSFileName) '打开Excel表
*R = oExcel.SHEETS(1).UsedRange.ROWS.Count '有数据的总行数
*C = oExcel.SHEETS(1).UsedRange.Columns.Count '有数据的总列数
*oExcel.Cells(R, C).Select '选中数据
*oExcel.Columns.AutoFit '让所有的列宽都自动调整
oExcel.DisplayAlerts = Flase '不显示提示框
oExcel.ActiveWorkbook.SaveAs FileName:=lcDFileName, FileFormat:=8
oExcel.ActiveWorkbook.saved = Ture '不保存当前EXCEL表
oExcel.Workbooks.Close '关闭表
oExcel.Quit '退出EXCEL
Set oExcel = Nothing '释放对象
MsgBox ("Excel文件: " & lcSFileName & " 另存为 " & lcDFileName & " 完成!")
 

*!* 62.VFP用ADO连接Excel,然后将Excel内容导出DBF的方法
*--以下代码是将123.XLS中的SHEET5中的内容转换成RR.DBF
oConnection = Createobject("adodb.connection") &&建立连接对象
With oConnection
    .ConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=d:\temp\123.xls;Extended Properties="excel 8.0;HDR=YES;IMEX=1;";Persist Security Info=False'
    .Open
Endwith
oConnection.EXECUTE('select * into [dBase III;DataBase=d:\temp].rr from [sheet5$]')
oConnection.Close
 

*!* 63.设置打印参数:
用Excel做报表,可打印时怎么选择打印机,即.ActiveWindow.SelectedSheets.PrintOut的参数有哪些?
Expression.PrintOut(From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName)
Expression 必选。该表达式返回“应用于”列表中的某个对象。
From Variant 类型,可选。打印的开始页号。如果省略该参数,将从起始位置开始打印。
To Variant 类型,可选。打印的终止页号。如果省略该参数,将打印至最后一页。
Copies Variant 类型,可选。要打印的份数。如果省略该参数,将只打印一份。
Preview Variant 类型,可选。如果为 True 则 Microsoft Excel 打印指定对象之前进行打印预览。如果为 False,或者省略此参数则立即打印该对象。
ActivePrinter Variant 类型,可选。 设置活动打印机的名称。
PrintToFile Variant 类型,可选。如果为 True 则打印输出到文件。如果没有指定 PrToFileName,则 Microsoft Excel 将提示用户输入要输出文件的文件名。
Collate Variant 类型,可选。如果为 True 则逐份打印每份副本。
PrToFileName 可选,Variant 类型。如果将 PrintToFile 设置为 True,则本参数指定要打印到的文件名。
说明
From 参数和 To 参数所描述的“页”指的是要打印的页,并非指定工作表或工作簿中的全部页。
 

*!* 64.如何用编程的方法打开有密码的Excel文件?
*Excel文件加了密码,如何在VFP中用编程的方式把密码输入,使Excel文件打开
oExcel=Createobject('Excel.application')
oExcel.Workbooks.Open("d:\22.xls")
这样还有一个密码的对话框出来,需要输入密码才能打开文件。
 

*!* 65.如何用编程的方法直接打开有密码的Excel文件?
oEle.Workbooks.Open("d:\22.xls",.F.,.F., ,"123","456")
"123"表示打开权限的密码,
"456"表示修改权限的密码.
 

*!* 66.如何将一个已知路径的图片插入到excel中.
oexcel1.ActiveSheet.PictureS.Insert("图片文件名")
 

*!* 67.能不能指定在某一位置或区域放置图片并控制图片显示大小呢?
OLEAPP.SHEETS(1).Select
oleapp.Range("位置").Select
oleapp.ActiveSheet.PictureS.Insert("图片文件名")).Select
oleapp.Selection.ShapeRange.LockAspectRatio =.T.
oleapp.Selection.ShapeRange.Height = 57
 

*!* 68.类型为字符型的字段输出到excel 中,前面的零被自动去掉,例如“009877”变为“9877”,怎么解决?
1.在字符串前面加半角单引号“ ' ”,
例如:
o.Cells(1,1).Value="'0123"
或用变量
cString="'"+"0123" &&其中0123可以取自表中一个字段
o.Cells(1,1).Value=cString &&o.Range("A1:A1").value=cString
2.
oExcel.CELLS(1,1).Select &&或eole.Range("A1:E1").Select
oExcel.Selection.NumberFormatLocal = "@" &&把被选定的单元格设为文本格式
oExcel.Cells(1,1).Value="0123" &&给所选单元格覆值
 

*!* 69.在 Excel 中插入行和列 :
objExcel.Rows(1).Insert() &&在第一行前面插入一行
objExcel.Columns(2).Insert() &&在第二列前面插入一列
 

*!* 70.获取 Excel 记录数
loXls = Createobject("excel.application")
bookExcel = loXls.Application.Workbooks.Open("f:\pz.xls")
nrows=bookExcel.Worksheets('pz')
UsedRange =nrows.UsedRange
r=UsedRange.Rows.Count &&有数据的总行数
c=UsedRange.Columns.Count &&有数据的总列数
loXls.Workbooks.Close
loXls.Quit
 

*!* 71.在EXCEL中如何在打开文件的同时自动执行一个宏命令。
只要将宏的命名为 AUTO_OPEN 即可。
如果要在文件关闭时运行,则命名为auto_close 。
 

*!* 72.在VFP中可以执行EXCEL的选择性粘贴吗?
.Range("A2").PasteSpecial ("xlPasteValues") && 会出错
.Range("A2").PasteSpecial (3) && 也会出错
.Range("A2").PasteSpecial && 只好这样了
 

*!* 73.如何才能只粘贴值呢?
xlPasteValues=-4163
oExcel.Range("A1").Select
oExcel.Selection.Copy
oExcel.Range("B1")._PasteSpecial(xlPasteValues)
*注意:在Excel 中,"xlPasteValues"是一个常量,它的值是一个数值型的:-4163
oExcel.Range("A1").Copy
oExcel.Range("B3").PasteSpecial(8) &&粘贴行、列宽
oExcel.Range("B3").PasteSpecial(-4122) &&粘贴格式
 

*!* 74.如何从excel读取数据
*******建立一个excel对象*******
Local hb1 As excel.Application
csheetname=Trim(Thisform.text2.Value)&&读取用户要读取excel的sheet名
***读取数据源所在的EXCEL文件名****
If Empty(Trim(Thisformset.filepath))
    Messagebox("请先选择要导入的excel文件!",0,"提示")
    Return
Endif
If Empty(Trim(csheetname))
    Messagebox("请先选择要导入的工作表sheet名称!",0,"提示")
    Return
Endif
Try
    hb1=Createobject("excel.application")
Catch
    Messagebox("请检查你是否已安装microsoft excel应用程序!",0,"提示")
Endtry
***打开EXCEL对象,开始读取数据********
HB1.workbooks.Open(Trim(Thisformset.filepath))
hb1.Sheets(csheetname).Select
Sele Store&&这是要读取的数据存放的表
Zap
isend=.F. &&用于判断是否记录已到底
i=1
Do While isend=.F.
    Append Blank
    crq=Dtoc(drq)
    cdh=hb1.Cells(i,1).Value
    If Isnull(cdh)
        cdh=""
    Endif
    **用于判断数据类型,数据类型一定要判断是否为NULL,**
    ** 然后如果不是指定的类型,还要进行转换*************
    If Type("cdh")<>'C'
        cdh=Alltrim(Str(cdh))
    Endif
    cdwmc=Trim(hb1.Cells(i,2).Value)
    If Isnull(cdwmc)
        cdwmc=""
    Endif
    cgg=hb1.Cells(i,3).Value
    If Isnull(cgg)
        cgg=""
    Else
        If Type("cgg")<>'C'
            cgg=Alltrim(Str(cgg))
        Endif
    Endif
    cjldw=hb1.Cells(i,4).Value
    If Isnull(cjldw)
        cjldw=""
    Endif
    cjldw=Iif(Type("jldw")<>"C",Alltrim(Str(cjldw)),Alltrim(cjldw))
    nsl=hb1.Cells(i,5).Value
    If Isnull(nsl)
        nsl=0
    Endif
    cch=Trim(hb1.Cells(i,6).Value)
    If Isnull(cch)
        cch=''
    Endif
    cxh=hb1.Cells(i,8).Value
    If Isnull(cxh)
        cxh=""
    Else
        If Type("cxh")<>'C'
            cxh=Trim(Str(cxh))
        Else
            cxh=Trim(cxh)
        Endif
    Endif
    ccpmc=hb1.Cells(i,9).Value
    If Isnull(ccpmc)
        ccpmc=''
    Endif
    If Type("ccpmc")<>'C'
        ccpmc=Alltrim(Str(ccpmc))
    Else
        ccpmc=Trim(ccpmc)
    Endif
    Select Store
    Replace rq With crq,dh With cdh,dwmc With cdwmc,gg With cgg,jldw With cjldw,sl With nsl,ch With cch,cpbh With cxh,cpmc With ccpmc
    i=i+1
    &&如果一行全为空,记作记录到底,如果中间存在多行的问题,我没有做考虑****
    If Empty(cxh) And nsl=0 And Empty(cch) And Empty(cjldw) And Empty(cdh) And Empty(cgg)
        isend=.T.
    Endif
Enddo
Dele &&最后一行为空行,删除
Wait "共转换得到"+Alltrim(Str(Reccount()))+"条记录!" Window Timeout 2
hb1.Quit
 

*!* 75.本程序通过将原dbf表拷成excel格式,然后导入并设置报表格式
Para tablename
Local hb1 As excel.Application
Wait "正在导出数据,请稍侯……" Window At 20,30 Timeout 1
bhaveerror=.F. &&定义一个变量判断是否发生错误
Try
    hb1=Createobject("excel.application")
Catch
    Messagebox("请检查你是否已安装microsoft excel应用程序!",0,"提示")
    bhaveerror=.T.
Endtry
If bhaveerror=.T.
    Return
Endif
If Right(curr_path,1)<>'\'
    curr_path=curr_path+"\"
Endif
ctablename=tablename+"_excel"
filepath=curr_path+"temp\sheet1.xls"
*filepath="temp\sheet1.xls"
If !File(filepath)
    Messagebox("数据源的excel文件未生成,报表生成被终止!")
    Return
Endif
HB1.workbooks.Open(filepath)
HB1.SHEETS("sheet1").Select
hb1.sheets(1).Rows(1).entirerow.Insert
hb1.sheets(1).Rows(1).entirerow.Insert
Sele (ctablename)
nfieldcount=Fcount()
nreccount=Reccount()
hbdygs="A1:"+Chr(nfieldcount+64)+"2"
HB1.Range(hbdygs).Select
****合并两行作为报表标题*************
HB1.Selection.HorizontalAlignment = 3 &&水平方向 2左对齐,3居中,4右对齐
HB1.Selection.VerticalAlignment = 2 &&垂直方向 1靠上,2居中,3靠下
HB1.Selection.WrapText = .F. && ??
HB1.Selection.Orientation = 0 && ??
HB1.Selection.AddIndent = .F. && ??
HB1.Selection.ShrinkToFit = .F. && ??
HB1.Selection.MergeCells = .T. && ??
HB1.Range(hbdygs).FormulaR1C1 = "请输入报表标题"
HB1.Range(hbdygs).Characters.Font.Name = "隶书"
HB1.Range(hbdygs).Characters.Font.FontStyle = "常规"
HB1.Range(hbdygs).Characters.Font.ColorIndex = 1 &&字符颜色
***根据数据源表结构的宽度设置列的宽度********
Copy Stru Exte To temp\term_stru
Sele 0
Use temp\term_stru
Select (ctablename)
For i=1 To nfieldcount
    cvalue=Allt(Field(i))
    Select term_stru
    Loca For Lower(Allt(field_name))==cvalue
    If Found()
        columnname=Chr(i+64)+":"+Chr(i+64)
        hb1.Columns(columnname).ColumnWidth=field_len
    Endif
    Sele (ctablename)
Endfor
Sele term_stru
Use
activecellname=Chr(nfieldcount+64)+Allt(Str(nreccount+3))
*************设置数据区域的字体格式***************
HB1.Range("A3:"+activecellname).Characters.Font.Name = "宋体"
HB1.Range("A3:"+activecellname).Characters.Font.Size= 9
HB1.Range("A3:"+activecellname).Select
hb1.Selection.BorderS(1).LineStyle = .T.
hb1.Selection.BorderS(2).linestyle = .T.
hb1.Selection.BorderS(3).linestyle = .T.
hb1.Selection.BorderS(4).linestyle = .T.
hb1.ActiveWorkbook.SaveAs("c:\aa.xls")
hb1.Application.Visible=.T.
* HB1.ACTIVEWORKBOOK.SAVE &&自动保存数据
* HB1.ACTIVEWORKBOOK.CLOSE &&关闭当前工作簿
* HB1.QUIT
 
*!* 76.如何修改sheet工作表名:
EFILENAME='D:\TEST\TEMPA.XLS'
oExcel=Createobject("Excel.application")
oExcel.Workbooks.Open("&EFILENAME")
oExcel.Visible=.T.
oExcel.Worksheets("Sheet2").Select
oExcel.Worksheets("Sheet2").Name='NewSheet' &&这里的NewSheet为新的名字。


*!* 77.复制Sheet工作表
EFILENAME='D:\你的Excel表名.XLS'
oExcel=Createobject("Excel.application")
oExcel.Workbooks.Open("&EFILENAME")
oExcel.Visible=.T.
oExcel.SHEETS(1).Select
oExcel.SHEETS(1).Copy(Null,oExcel.SHEETS(1)) &&&&把第1个工作表复制到第1个工作表之后
oExcel.SHEETS(2).Name='NewSheetName' &&设置第2个工作表名称
*!*oExcel.SHEETS(1).COPY(oExcel.SHEETS(1),NULL) &&&&把第1个工作表复制到第1个工作表之前
*!*oExcel.SHEETS(1).NAME='NewSheetName' &&设置第1个工作表名称
 
*!* 78.如何将DBF中内容COPY到EXCEL的指定区域
例如我有一个DBF:
Name_F Sl_f
Mike 546
kyle 200
想将这个内容转到EXCEL里面的E1:F2区域!
Use 表名
_vfp.DataToClip('表名',Reccount(),3) &&将一组记录作为文本复制到剪贴板上,3使用制表符分隔字段。
oexl=Createobject('excel.application') &&创建电子表格
oexl.Visible=.T. &&使电子表格可见
oexl.workbooks.Add &&创建工作簿
With oexl
    .Range("E1:F2").Select &&根据你的表中的记录数和字段数调整此项中的'F2'
    .ActiveSheet.Paste
Endwith


*!* 79.VFP调用EXCEL查询打印示例
EFILENAME='查询打印.XLS'
*LOCAL oExcel
oExcel=Createobject("Excel.application")
oExcel.Workbooks.Open("&EFILENAME")
oExcel.Caption="VFP应用程序调用Microsoft Excel"
oExcel.Worksheets("查询打印").Activate
oExcel.Visible=.T.
nRows=oExcel.Worksheets('查询打印').UsedRange.Rows.Count
nColumns=oExcel.Worksheets('查询打印').UsedRange.Columns.Count
oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nColumns)).BorderS.LineStyle=1
oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nColumns)).HorizontalAlignment=3 &&水平(1-默认、2-靠左、3-居中、4-靠右、5-填充、6=两端对齐、7=跨列居中、8=分散对齐)
oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nColumns)).VerticalAlignment=2 &&垂直(1=靠上、2=居中、3=靠下、4=两端对齐、5=分散对齐)
oExcel.ActiveSheet.PageSetup.RightFooter="第&P页 / 共&N页"
oExcel.ActiveSheet.PageSetup.TopMargin=2/0.035 &&设置顶边距为2厘米
oExcel.ActiveSheet.PageSetup.BottomMargin=2/0.035 &&设置左边距为2厘米
oExcel.ActiveSheet.PageSetup.HeaderMargin=1/0.035 &&设置页眉到顶端边距为1厘米
oExcel.ActiveSheet.PageSetup.FooterMargin=1/0.035 &&设置页脚到底边距为1厘米
oExcel.ActiveSheet.PageSetup.LeftMargin=2/0.035 &&设置左边距为2厘米
oExcel.ActiveSheet.PageSetup.RightMargin=2/0.035 &&设置右边距为2厘米
oExcel.ActiveSheet.PageSetup.CenterHorizontally=.T. &&设置页面水平居中
oExcel.ActiveSheet.PageSetup.CenterVertically=.T. &&设置页面垂直居中
oExcel.ActiveSheet.PageSetup.Zoom=90 &&缩放90%
oExcel.Cells.Select
oExcel.Cells.EntireColumn.AutoFit
oExcel.Selection.AutoFilter
oExcel.ActiveSheet.Rows(1).Insert
oExcel.Range("A2:BB2").RowHeight=37.5
oExcel.Range("A2:BB2").WrapText=.T.
oExcel.ActiveSheet.Columns(1).ColumnWidth=3
oExcel.ActiveSheet.Columns(1).ColumnWidth=4
oExcel.Range("A2:BB2").RowHeight=12.5
*oExcel.RANGE("M1").VALUE='统计月份:'+ALLTRIM(STR(YEAR(KKS_DATE1)))+'年'+ALLTRIM(STR(MONTH(KKS_DATE1)))+'月 - '+ALLTRIM(STR(YEAR(KKE_DATE1)))+'年'+ALLTRIM(STR(MONTH(KKE_DATE1)))+'月'
oExcel.ActiveSheet.PageSetup.CenterHeader="&20部 门 出 勤 统 计 表"
oExcel.ActiveSheet.PageSetup.CenterFooter="单位领导:"
oExcel.ActiveSheet.PageSetup.LeftFooter="打印时间:&D - &T"
oExcel.Selection.AutoFilter
oExcel.ActiveSheet.Range('B2').Select
oExcel.ActiveSheet.PageSetup.PrintTitleRows="$1:$1"
oExcel.ActiveSheet.PageSetup.Orientation=2 && 1:纵向打印 2:横向打印
oExcel.ActiveWorkbook.Save


*!* 80.Excel报表巧生成
巧让FoxPro数据生成Excel报表
Visual FoxPro是应用广泛的前台数据库开发平台之一,因此在我们日常工作中时常会遇到DBF数据文件。然而随着办公自动化的普及,越来越多的时候需要将DBF文件转化为Excel电子文档。常用转化方法是在FoxPro中用Copy命令进行格式转化或直接用Excel打开DBF文件。这两种方式虽然都能达到目的,却不能得到格式规范、可以直接打印输出的报表,且输出的Excel文件中,无法对数据类型进行有效转换,极易出现数据统计错误。有没有更好的方法呢?这里有一个更加通用的方法,在VFP中调用Excel,可以由DBF文件直接生成格式如下图所示一样复杂的Excel报表(如图1)。 Excel报表
具体过程如下:
编辑推荐文章
● 新鲜接触Excel 2000 XP
● Excel 2000公式应用的几条经验
● Excel 2000函数应用之信息函数
假设我们要将表Agcallop.dbf文件输出为Excel格式文档,报表形如图1所示。为使通用性更强,页面采用A4纸横向输出,默认字体为宋体10号,页脚处添加页号。
部分程序代码如下:
m.outfilename=Putfile('输出结果','agcallop','xls')
&&取导出文件名称
ef=Createobject('Excel.application')
&&调用Excel程序
ef.Workbooks.Add
&&添加工作簿
ef.Worksheets("sheet1").Activate
&&激活第一个工作表
ef.Visible=.T.
&&显示Excel界面
ef.Cells.Select
&&选择整张表
ef.Selection.Font.Size = 10
&&设置整表默认字体大小为10
Select 0
Use agcallop
&&选择被导出的表
num=Reccount()
&&求导出总记录数
Go Top
i=5
ef.Range("F1:K1").Select
&&选择标题栏所在单元格
ef.Selection.Merge
&&合并单元格
With ef.Range("F1 ")
    &&设置标题及字体属性
    .Value='客户服务部业务代表工作量情况统计表'
    .Font.Name="黑体"
    .Font.Size=18
Endwith
ef.Rows(2).RowHeight=1/0.035
&&设置第二行高度为1cm
ef.Range("H2:O2").Select
&&选定统计条件栏所在单元格
ef.Selection.Merge
&&合并单元格
ef.Range("H2").Font.Size=10
ef.Range("H2").HorizontalAlignment=4
&&设置内容对齐方式为右对齐,3为居中,4为右对齐
ef.Range("H2").Value='统计时间:'+Dtoc(Date())+' 打印日期:'+Dtoc(Date())
ef.Rows("3:4").Select
With ef.Selection
    .HorizontalAlignment = 3
    &&设置3、4行为水平对齐
    .VerticalAlignment = 2
    &&垂直居中
    .NumberFormatLocal = "@"
    &&设置3、4行为字符型内容
Endwith
ef.Range("A3:A4").Select
ef.Selection.Merge
&&纵向合并第一列3、4行
ef.Range("A3").Value='工号'
&&设置第一列标题内容
ef.Columns("A").Select
&&整列选择
ef.Selection.HorizontalAlignment = 3
&&水平居中
ef.Columns("A:B").Select
ef.Selection.NumberFormatLocal = "@"
&&设置A、B列为字符型内容
ef.Range("B3:B4").Select
ef.Selection.Merge
&&纵向合并第二列3、4行
ef.Range("B3").Value='姓名'
&&设置第二列标题内容
ef.Columns("B").Select
&&整列选择
ef.Selection.HorizontalAlignment = 3
&&水平居中
ef.Range("C3:E3").Select
&&横向合并第三行C-E列
ef.Selection.Merge
ef.Range("C3").Value='话务总量'
&&第三行大标题为“话务总量”的列
ef.Range("C4").Value='电话呼入量'
&&“话务总量”下第1个小标题“电话呼入量”
ef.Range("D4").Value='电话呼出量'
&&“话务总量”下第2个小标题“电话呼出量”
ef.Range("E4").Value='合 计'
&&“话务总量”下第3个小标题“合计”
ef.Range("F3:H3").Select
ef.Selection.Merge
ef.Range("F3").Value='话务总时间'
ef.Range("F4").Value='呼入时间'
ef.Range("G4").Value='呼出时间'
ef.Range("H4").Value='合 计'
ef.Range("I3:K3").Select
ef.Selection.Merge
ef.Range("I3").Value='单个话务平均时间'
ef.Range("I4").Value='呼入时间'
ef.Range("J4").Value='呼出时间'
ef.Range("K4").Value='合 计'
ef.Range("L3:L4").Select
ef.Selection.Merge
ef.Range("L3").Value='累计工作时间'
ef.Range("M3:M4").Select
ef.Selection.Merge
ef.Range("M3").Value='无效时间'
ef.Range("N3:N4").Select
ef.Selection.Merge
ef.Range("N3").Value='录入量'
ef.Range("O3:O4").Select
ef.Selection.Merge
ef.Range("O3").Value='有效时间比'
接下来通过scan语句,依次为每一行每一列单元格赋值。为了获得更好的打印效果,还需进行页面设置,如标题行、页面居中、横向排版等,还可以加边框线。
以上程序在VFP 6+Excel 2000+Windows 2000下调试通过。实际应用中可根据需要对各项参数设置进行相应调整。

 


 

  评论这张
 
阅读(1133)| 评论(0)
推荐 转载

历史上的今天

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017