| 主题：VFP的GRID特别显示和操作WORD-EXCEL示例
|
|
楼主
曾有编程爱好者多次求我帮做Word模板，填写资料。当时也找不到资料。只告诉他
要写资料的那一页用EXCEL，因EXCEL的参考资料多。后见他在多个论坛求助，未见解决。
刚好闲点，花点时间研究了一下WORD，终于知道怎样如控制EXCEL一样来控制WORD。
写成例子贴出来与大家共享,都有两方法，一是直接用代码编程创建文档，另是在WORD或
EXCEL中作好模板，用模板创建，添写资料。我中意后者。
另附 GRID 模仿DELPHI的显示
总结以下几点，就可更加发挥：
一、要实现的目的，先在WORD或EXCEL中录制宏。然后根据宏来修改做成VFP的代码。
二、对象的属性不同。
a、WORD ,
1、 凡有selection的为应用程序属性
OleWord=CREATEOBJECT('word.application') &&创建word目标
OleWord.Selection
**** Word多数用它**********
OleWord.quit &&退出word
2、OleWord.Documents
OleWord.Documents.add() &&增加新的word文档，有路径文件名是以它作模板打开
OleWord.Documents.open("D:\test.doc") &&打开指定的文件
OleWord.Documents.close(.F.) &&关闭所有打开的文档不保存，不要.F.，调出对话框
3、页面设置OleWord.ActiveDocument.PageSetup
4、OleWord.ActiveDocument
OleWord.ActiveDocument.Save &&保存
OleWord.ActiveDocument.SaveAs("D:\test.doc") &&最简单的另存
OleWord.ActiveDocument.close &&关闭当前word文档
b、EXCEL
1、凡有selection的为应用程序属性
XLApp=CREATEOBJECT('Excel.application')
XLApp.Selection
XLApp.quit &&退出Excel
2、XLApp.WorkBooks
XLApp.WorkBooks.Add( ) &&增加新的EXCEL，加有路径文件名是以它作模板打开
XLApp.Workbooks.Open("D:\test.xls") && 打开指定工作簿
XLApp.Workbooks.close(.F.) &&关闭所有打开的工作簿不保存，不要.F.，调出对话框
3、页面设置 XLApp.ActiveSheet.PageSetup
4、XLApp.ActiveSheet
********Excel多数用它与Word不同**********
5、XLApp.ActiveWorkbook
XLApp.ActiveWorkbook.Save &&保存
XLApp.ActiveWorkbook.SaveAs("D:\ABC\22.xls") &&另存为
XLApp.ActiveWorkbook.close &&关闭当前工作簿
三、WORD/EXCEL宏与VFP表示方法不同
a、WORD打开
OleWord.Documents.open("D:\test.doc",.F.,.F.,.F.,'456','123',.F.,'','',.F.) &&根据宏函数改，与保存不同方式,456为打开密码，123为只读密码
*宏函数 Documents.Open FileName:="temp.doc", ConfirmConversions:=False, ReadOnly:= _
* False, AddToRecentFiles:=False, PasswordDocument:="456", PasswordTemplate _
* :="123", Revert:=False, WritePasswordDocument:="123", WritePasswordTemplate _
* :="", Format:=wdOpenFormatAuto
b、EXCEL只读保护
XLApp.ActiveSheet.protect('123') &&用123密码锁起只读
XLApp.ActiveSheet.unprotect('123') &&用123密码解锁
*宏函数(用123密码只读锁) ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
* 用123密码解锁 ActiveSheet.Unprotect
徐 军 xj@meyerdyeing.com
2005/11/06
示例:
http://upload./upfile/20051122194626.rar
|
|
|
第1楼
部分代码：
*用WORD创建新文档，再根据DBF的资料创建自几所需要的表格文档
Thisform.chnagedbf &&转表查询生成新表、公用变量k,arrcolor[j,k],arrWash[1],arrCrock[1]
WAIT windows("起动WORD制做文档，请稍等....") NOWAIT AT MROW(Thisform.Name,3),MCOL(Thisform.Name,3)
OleWord=CREATEOBJECT('word.application') &&创建word目标
OleWord.Visible=.F. &&word隐藏，为.F.可在后台操作
OleWord.Documents.add() &&增加新的word文档
*-- 页面设置
WITH OleWord.ActiveDocument.PageSetup
*1．设置顶边距为2厘米
.TopMargin=2/0.035
*2．设置底边距为4厘米
.BottomMargin=4/0.035
*3．设置左边距为2厘米
.LeftMargin=2/0.035
*4．设置右边距为2厘米
.RightMargin=2/0.035
*页面0为纵向，1为横向
.Orientation=1
ENDWITH
**********************************************************************************
WITH OleWord.Selection
.TypeParagraph &&回车符
.Text="致" &&加完是选定状态
.Font.size=20 &&字体大小
.Moveright(3,1) &&加完是选定状态，移动一次才不覆盖,3是右移参数，左移1字节。
.TypeParagraph
.insertafter(SPACE(4)+"兴启")
.Font.size=20
.Moveright(3,1)
.TypeParagraph
.Moveright(3,1)
.insertafter(SPACE(6)+"多谢贵公司的支持，贵公司在我厂所配COT样办牢度如下：")
.Font.size=14
.Moveright(3,1)
.TypeParagraph
ENDWITH
******创建表格*******************************
OleWord.Selection.TypeParagraph
OleWord.Selection.TypeParagraph
OleWord.Selection.Moveup(5,1) &&第一个5是上移参数，第二个数字是上移1行,留一空行在格表下面
otemp=OleWord.Selection.Range
OleWord.ActiveDocument.Tables.Add(otemp,k+3,6,5,0) &&插入k+3行6列表格
OleWord.Selection.SelectRow
&&光标在第一格，要移动用Moveright() 等
WITH OleWord.Selection
.Tables(1).Rows.Height=0.77/0.035 &&选定表格所有行高0.77CM
.Tables(1).Columns.PreferredWidth=2.5/0.035 &&选定表格所有列宽 1.9cm
.Tables(1).Columns(1).PreferredWidth=4.73/0.035 &&选定表格第一列宽 4.73cm
*添加数据,表格合并后就不能用此方法加资料
.Tables(1).rows(3).cells(3).range.insertafter("颜色变化")
.Tables(1).rows(3).cells(4).range.insertafter("颜色沾色")
.Tables(1).rows(3).cells(5).range.insertafter("干 擦")
.Tables(1).rows(3).cells(6).range.insertafter("湿 擦")
FOR i=1 TO k
FOR j=1 TO 6
.Tables(1).rows(i+3).cells(j).range.insertafter(arrcolor[i,j])
ENDFOR
ENDFOR
**选定合并
.MoveLeft(3,1) &&左移去掉选定.第一个3是左移参数，第二个数字是左移1字节
.MoveDown(5,2,1) &&下移两格，5是下移参数，2是移两格，1是按SHIFT,选择3格
.Cells.Merge &&合并选定的三格
.MoveRight(3,1) &&右移去掉选定.第一个3是右移参数，第二个数字是右移1格
.MoveDown(5,2,1)
.Cells.Merge &&合并选定的三格
.MoveRight(3,1) &&右移一格去掉选定
.Moveright(3,2,1) &&3是右移参数，右移1格,最后1是按SHIFT键，变成选定二格。
.Cells.Merge &&合并选定的两格
.MoveDown(5,1)
.Moveright(3,2,1) &&3是右移参数，左移1格,最后1是按SHIFT键，变成选定二格。
.Cells.Merge &&合并选定的两格
.Moveright(3,1) &&右移一格去掉选定
.Moveright(3,2,1) &&3是右移参数，左移1格,最后1是按SHIFT键，变成选定二格。
.Cells.Merge &&合并选定的两格
.Moveup(5,1) &&上移一格，5是下移参数，2是移两格，1是按SHIFT,选择3格
.Moveright(3,2,1)
.Cells.Merge
***加入资料,因要合并不方便操作，所以合并后加放标题资料
.insertafter("摩 擦")
.MoveDown(5,1)
.insertafter(arrCrock[1])
.MoveLeft(3,2)
.insertafter(arrWash[1])
.Moveup(5,1)
.insertafter("耐 洗")
.MoveLeft(3,2)
.insertafter("颜 色")
.MoveLeft(3,2)
.insertafter("色 号")
.MoveDown(5,k,1) &&5是下移参数，下移k+2格,最后1是按SHIFT键，变成选定多格。
.MoveRight(3,5,1) &&3是右移参数，右移5格,最后1是按SHIFT键，变成选定多格。
.ParagraphFormat.Alignment=1 && 1居中 2左对齐，3右对齐，4分散对齐
.MoveDown(5,1)
.TypeParagraph
.insertafter(SPACE(4)+"祝")
.MoveRight(3,1)
.TypeParagraph
.insertafter("生意兴隆！")
.MoveRight(3,1)
.TypeParagraph
.insertafter(SPACE(25)+"先科有限公司")
.Font.size=20
.Moveright(3,1)
.TypeParagraph
.insertafter(SPACE(30)+DTOC(DATE()))
.Moveright(3,1)
ENDWITH
MESSAGEBOX("制作文档完毕!",64,"提示")
OleWord.Visible=.T.
|
|
| 作者：hhxcr 发表时间：2005-11-5 22:12:00
|
第3楼
|
|
第4楼
表格特别显示图：
|
|
|
第5楼
在表格的init:
STORE RGB(195,195,195) TO THISFORM.Grid1.GridLineColor,THISFORM.Grid1.BackColor
THISFORM.Grid1.SetAll("BackColor",RGB(255,255,255),"TextBox")
ThisForm.Grid1.SetAll("DynamicBackColor", "IIF(MOD(RECNO( ), 2)=0,
RGB(248,243,252),RGB(255,255,255))", "Column") && Alternate
color
IF TYPE("gnCurrRec")="U"
PUBLIC gnCurrRec
ENDIF
STORE 1 TO gnCurrRec
ThisForm.Grid1.SetAll("DynamicForeColor","IIF(RECNO()=gnCurrRec,RGB(255,0,0),IIF(MOD(RECNO(),2)=0,RGB(0,0,255),This.ForeColor))","Column")
在表格的afterRowColChange:
LPARAMETERS nColIndex
gnCurrRec=RECNO()
This.Refresh
|
|
| 作者：飞扬988 发表时间：2005-11-6 10:46:00
|
第6楼
|
谢谢大哥，真的太漂亮了，已经达到效果了，这样的好贴不收藏可说不过去了。
|
|
|
第7楼
顶一个
|
|
|
第8楼
看了你的示例,你的主程序中
cPath=SYS(5)+SYS(2003)
SET DEFAULT TO &cPath
把你的程序放在路径中有空格的目录中运行 如我的文档,会提示出错,如果你改为
cPath=SYS(5)+SYS(2003)
SET DEFAULT TO (cPath)
可解决问题
另外,导出WORD还有一种方法就是先设计一个WORD表格,用VFP数据填入
这样对处理复杂的表格代码比较简捷
|
|
|
第9楼
|
空路径的问题知道，谢谢。至于第二个问题我的示例中就是第二方法，你可能没看，我也是中意在WORD、EXCEL中作好模板，再在VFP中调用。
|
|
| 作者：lwh1188 发表时间：2005-11-15 10:12:00
|
第10楼
|
| 作者：phph 发表时间：2005-11-16 11:13:00
|
第11楼
各位高手：
小女子这厢有礼了！！
本人纳一文科学生，怎奈学校偏偏开设了《数据库（foxpro for windows）教程》这门功课，现布置了一大堆作业题，小女子实在无从下手，经推荐来贵宝地寻求帮助。
课本关于“编写分支程序”的习题：
1 编写程序，设有一组数，找出这组数中能被6整除的数。
2 编写程序，有一正整数存于变量X中，判断它是几位数。
3 车站从甲地到乙地托运行李。收费规定：若行李重量小于等于50公斤，每公斤收费0.50元；若行李重量大于50公斤时，其超重部分加收0.40元，编写计算运费的程序。
|
|
|
第12楼
回11楼，见以下，复制到prg程序中运行
*1编写程序，设有一组数，找出这组数中能被6整除的数
CLEAR
input "请输入你创建的数组数" to nArr
DIMENSION Atest(nArr)
FOR i=1 TO nArr
input "请输入你创建的数组的第"+ALLTRIM(STR(i))+"个数:" to Atest[i]
ENDFOR
cMess="你输入的数组，被6整除的为:"
FOR j=1 TO nArr
IF MOD(Atest[j],6)=0
cMess=cMess+CHR(13)+ ;
"第"+ALLTRIM(STR(j))+"组，数据为"+ ALLTRIM(STR(Atest[j]))
ENDIF
ENDFOR
MESSAGEBOX(cMess,64,"结果提示")
*2 编写程序，有一正整数存于变量X中，判断它是几位数。
CLEAR
input "请输入一个整数" to nDigit
cDigit=ALLTRIM(STR(nDigit))
MESSAGEBOX("你输入的整数"+cDigit+"为:"+ALLTRIM(STR(LEN(cDigit)))+"位",64,"结果提示")
*3 车站从甲地到乙地托运行李。收费规定：若行李重量小于等于50公斤，每公斤收费0.50元；若行李重量大于50公斤时，其超重部分加收0.40元，编写计算运费的程序。
CLEAR
input "请输入行李重量公斤数:" to nDigit
nMoney=IIF(nDigit<=50,nDigit*0.5,50*0.5+(nDigit-50)*(0.5+0.4))
MESSAGEBOX("收费规定：若行李重量小于等于50公斤，每公斤收费0.50元；"+CHR(13)+ ;
"若行李重量大于50公斤时，其超重部分加收0.40元"+CHR(13)+ ;
"你的行李重量"+ALLTRIM(STR(nDigit))+"公斤，收费金额为:"+ALLTRIM(STR(nMoney))+"元",64,"结果提示")
|
|
| 作者：sianfox 发表时间：2005-11-16 18:30:00
|
第13楼
|
|
第14楼
加了VFP转EXCEL图表
SELECT TOP 11 date,high FROM stock ORDER BY date INTO CURSOR curtemp &&选择数据生成临时表
SELECT curtemp
COPY TO stock.xls TYPE XL5 &&生成EXCEL表
XLApp=CREATEOBJECT('Excel.application') &&创建EXCEL应用程序
XLApp.Visible = .T. && 显示Excel窗口
strFile=alltr( SYS(5) + SYS(2003) +"\stock.xls")
XLApp.Workbooks.Open(strFile) && 打开指定工作簿
WITH XLApp
.Range("A1:B12").Select &&选定范围作图
.Charts.Add &&作图
.ActiveChart.Location(2,'stock') &&作图为对象插入
.ActiveChart.HasDataTable =.F.
.ActiveSheet.Shapes("图表 1").IncrementLeft(-43.5) &&图表左移
.ActiveSheet.Shapes("图表 1").IncrementTop(-66) &&图表上移
.ActiveSheet.ChartObjects("图表 1").Activate &&图表激活
.ActiveChart.ChartArea.Select &&图表面积选择
.ActiveSheet.Shapes("图表 1").Width=.ActiveSheet.Shapes("图表 1").Width-0.5 &&减少宽0.5cm
.ActiveSheet.Shapes("图表 1").Height=.ActiveSheet.Shapes("图表 1").Height+40 &&增加高
.ActiveSheet.Shapes("图表 1").IncrementLeft(1.5)
.ActiveSheet.Shapes("图表 1").IncrementTop(-10.5)
.Range("A13").Select &&选择单元格
.ActiveSheet.PrintPreview &&打印浏览
* .ActiveSheet.PrintOut &&打印输出工作表
ENDWITH
|
|
|
第15楼
图
|
|
| 作者：jianzho 发表时间：2005-11-23 20:56:00
|
第17楼
|
|
第18楼
徐军你好,看了你的贴子,觉得你在VFP这块造旨实在太高,而且学习能力特强.所以有两个题目在此提出,希望你能解决.
第一个是关于调用Excel绘制剖面图的问题,X坐标默认结点是等间距的,能不能根据实际的情况确定结点间距离?
第二个是电脑拨号程序的问题,网上现有资料只解决了拨号问题,拨通后能否自动转换到座机上? 能否/怎样接受对方按键信息? 电话拨通后,怎样播放录音给对方听?等等功能,用VFP能否实现?
请赐教!
|
|
|
第19楼
x37、X35、X24、X25、X53、X56、X57-4是油井平面分布图中一个剖面上的井位，它们之间的距离实际上是不等的。但我没法根据实际间距调整它们的距离。
|
|
|
第21楼
第一个问题图片你发到我的邮箱，我在网上看不到,最好是EXCEL图表，我才好写
*****************************************
第二个问题我试验不到，提供点资料参考
串口通信实例
2002-1-3
下列代码是一个控制串口的实例：
ole1：MSCOMM32控件；
SuperTracker：是一个接在串口上的设备；
chr()中的值是该设备的指令。
para nnn
serr=0
thisform.ole1.output=chr(2)+chr(6)+chr(3)
ltime=datetime()
do whil thisform.ole1.InBufferCount=0
if datetime()-ltime>12
=msg("警告","得不到SuperTracker的控制信号。","!O")
thisform.ole1.portopen=.f.
serr=1
retu
endif
enddo
mscomm=thisform.ole1.input
if str(mscomm(1),1)+str(mscomm(2),1)+str(mscomm(3),1)<>'263'
=msg("警告","得不到SuperTracker的控制信号。","!O")
thisform.ole1.portopen=.f.
serr=1
retu
endif
do case
case nnn=1
thisform.ole1.output=chr(2)+chr(35)+chr(83)+chr(3)
case nnn=2
thisform.ole1.output=chr(2)+chr(35)+chr(85)+chr(3)
case nnn=3
thisform.ole1.output=chr(2)+chr(35)+chr(66)+chr(3)
endcase
ltime=datetime()
do whil thisform.ole1.InBufferCount=0
if datetime()-ltime>20
=msg("警告","得不到SuperTracker的控制信号。","!O")
thisform.ole1.portopen=.f.
serr=1
retu
endif
enddo
mscomm=thisform.ole1.input
if str(mscomm(1),1)+str(mscomm(2),1)+str(mscomm(3),1)<>'263'
do case
case nnn=1
=msg("警告","SuperTracker无法进卡。","!O")
case nnn=2
=msg("警告","SuperTracker卡在里面。","!O")
case nnn=3
=msg("警告","SuperTracker卡在出口处。","!O")
endcase
thisform.ole1.portopen=.f.
serr=1
retu
endif
|
|
|
第23楼
jinlonggao
第一个是关于调用Excel绘制剖面图的问题,X坐标默认结点是等间距的,能不能根据实际的情况确定结点间距离.
你改变一种思考方法就海阔天空。不要只想到制表，你在EXCEL中画坐标，以单元格为纵横，可编程随意改变结点间距离，两头加一个箭头，中间的油井，
根据坐标加入一个圆圈。我想与将DBF数据循环加入EXCEL中没多大区别，关键是算好，纵横坐标是换算成以单元格为准。
|
|
|
第24楼
徐军老师的思路确实很好,这样一来,中间的每个单元格都得算出一个中间值来.而且中间值得由两个井的值按照一定的算法计算.难度有些大.剖面线画成折线很简单,画成圆滑曲线可就难了.请问徐军老师有没有更好的思路解决?
我想若能直接设定两井间距,就可利用EXCEL本身的办法确定是折线,还是圆滑曲线.
|
|
|
第25楼
|
正确的做法是用等间距离，缩放比例，用x,y座标，地球是圆都可做成平面或切面图来。我是做染色一行，对你的不了解，不是很明白你的意思。也到网上找找
|
|
| 作者：lc0315 发表时间：2005-12-13 16:38:00
|
第26楼
|
|
第27楼
1、你用版本高的WINRAR 3.40以上
2、你重新下载
|
|
|
第29楼
|
楼主好：我是一个新手，您的文章我还是看不大懂。请问，若是想在vfp中导入整个excel表，应该怎样做？？？
|
|
| 作者：WHHZCY 发表时间：2006-1-4 8:06:00
|
第31楼
版主，你好！
首先感谢您的无私奉献！
看到你这么高的水平我想请教一个问题，那就是：
在VF 中如何查找并替换WORD中的内容呢？
用WORD中的替换宏命令VF提示错误。
望您能不吝赐教。
|
|
|
第32楼
WAIT windows("起动WORD文档替换文本，请稍等....") NOWAIT AT MROW(Thisform.Name,3),MCOL(Thisform.Name,3)
OleWord=CREATEOBJECT('word.application') &&创建word目标
OleWord.Visible=.T. &&word隐藏，为.F.可在后台操作
cDirFile="C:\Documents and Settings\yx\My Documents\中华人民共和国出入境检疫.doc" &&你的WORD文档(要绝对路径)
OleWord.Documents.add(cDirFile) &&打开文档
WITH OleWord.Selection.Find
.ClearFormatting
.Text = "中文" &&要查找的文本
.Forward =.T.
.Wrap=1
.Execute
ENDWITH
lFind=OleWord.Selection.Find.found
OleWord.Selection.Text="Test" &&查找后替换的文本
DO WHILE lFind &&调用替换不成功，改用查找替换do while方法
WITH OleWord.Selection.Find &&以下不重复就不替换
.ClearFormatting
.Text = "中文" &&要查找的文本
.Forward =.T.
.Wrap=1
.Execute
ENDWITH
lFind=OleWord.Selection.Find.found
OleWord.Selection.Text="Test" &&查找后替换的文本
ENDDO
MESSAGEBOX("替换完毕.") | |
|
