1个回答
展开全部
给你个函数:
参数说明见下面
/*========================================================================*/
// 函数名: gf_dw2excel
// 作用范围: public
/*------------------------------------------------------------------------*/
// 描述: 将数据窗口的数据传递至EXCEL表格中,列数有26列限制(一般情况已经够用了)
/*------------------------------------------------------------------------*/
// 参数:
// [value] datawindow adw_data 需要保存的数据窗口
// [value] string as_reptitle 表格标题
/*------------------------------------------------------------------------*/
// 返回值: LONG
/*------------------------------------------------------------------------*/
// 作者: xiaolihua 日期: 2003-05-20
// 修改: DoItNow 日期: 2003.06.06
/*========================================================================*/
CONSTANT Integer ppLayoutBlank = 12
Pointer oldpointer
OLEObject ole_object
ole_object = CREATE OLEObject
String s_english = "ABCDEFGHIJKMNLOPQRSTUVWXYZ"
Integer li_ret
//////////////////////////////////////////////////////////////////////
//====================================================================
// Script - gf_dw2excel ( datawindow adw_data, string as_reptitle )
// [Reason]: 由于再已经打开EXCEL的情况下,使用连接OLE时有时出错,所以改为
// 直接连接新的OLE 应用。
//--------------------------------------------------------------------
// [MODIFIED By]: DoItNow Date: 2003.06.06
//====================================================================
//li_ret = ole_object.ConnectToObject("","Excel.Application")
//IF li_ret <> 0 THEN
// //如果Excel还没有打开,则新建。
li_ret = ole_object.ConnectToNewObject("Excel.Application")
IF li_ret <> 0 THEN
MessageBox('打开错误','无法连接EXCEL!是否已经安装了EXCEL?错误号:' + String(li_ret))
RETURN 0
END IF
ole_object.Visible = FALSE //ole应用服务是否显示
//END IF
//-------MODIFIED END-------------------------------------------------
//////////////////////////////////////////////////////////////////////
oldpointer = SetPointer(HourGlass!)
ole_object.Workbooks.Add
Long ll_colnum,ll_rownum
String ls_value
String ls_objects,ls_obj,ls_objs[],ls_objtag[],ls_width[]
Long ll_pos,ll_len,ll_num = 0
//Excel表格中的行数为数据窗口行数+2
ll_rownum = adw_data.RowCount() + 2
String ls_colname
Integer i,j
Dec ld_width
ll_colnum = Long(adw_data.Object.DataWindow.Column.Count) //取得字段总数
ls_objtag[1] = "序号"
SetNull(ls_width[1])
i = 1
FOR ll_num = 1 TO ll_colnum
IF adw_data.DESCRIBE("#"+String(ll_num)+".Visible") = "1" THEN //列标志为nun_Visible的不显示
i = i+1
ls_obj = adw_data.DESCRIBE("#"+String(ll_num)+".name") //字段名称的实际存储值
ls_objs[i] = ls_obj
ls_objtag[i] = adw_data.DESCRIBE(ls_obj + "_t.text") //字段名称的显示值
ls_width[i] = adw_data.DESCRIBE(ls_obj + '.width') //每列的宽度
END IF
NEXT
ll_colnum = i //表格列数
//生成总标题
ole_object.Cells(1,1).Value = as_reptitle
ole_object.Range('A1').SELECT
ole_object.Selection.Font.Size = 24
ole_object.Selection.HorizontalAlignment = 3
ole_object.Range('A1:'+Mid(s_english,ll_colnum,1)+'1').select
ole_object.Range('A1:'+Mid(s_english,ll_colnum,1)+'1').Merge
//设置标题栏
FOR i = 1 TO ll_colnum
ls_value = ls_objtag[i]
ole_object.Cells(2,i).Value = ls_value
IF IsNull(ls_width[i]) THEN
ld_width = 12
ELSE
ld_width = Dec(ls_width[i])/35 //why devided by 35 ???
END IF
ole_object.Columns(i).ColumnWidth = ld_width
ole_object.Columns(i).HorizontalAlignment = 3
ole_object.Columns(i).Borders.LineStyle = 1
ole_object.Columns(i).Font.Bold = TRUE
NEXT
//添充实际数据到EXCEL
String column_name,ls_coltype
FOR i = 3 TO ll_rownum
ole_object.Cells(i,1).Font.Bold = FALSE
ole_object.Cells(i,1).Value = i - 2
FOR j = 2 TO ll_colnum
column_name = ls_objs[j]
IF adw_data.DESCRIBE(column_name + '.type') = 'column' THEN
ls_value = adw_data.DESCRIBE("Evaluate('LookupDisplay("+column_name+")',"+String(i - 2)+")")
END IF
IF adw_data.DESCRIBE(column_name + '.type') = 'compute' THEN
ls_value = adw_data.DESCRIBE("Evaluate('" + adw_data.DESCRIBE(column_name + '.expression') + "',"+String(i - 2)+")")
END IF
ls_coltype = adw_data.DESCRIBE(column_name+'.coltype')
IF Pos(Upper(ls_coltype),"CHAR") > 0 THEN //对字符型数据处理
ole_object.Cells(i,j).NumberFormat = "@"
END IF
ole_object.Cells(i,j).Font.Bold = FALSE
ole_object.Cells(i,j).Value = ls_value
NEXT
NEXT
//////////////////////////////////////////////////////////////////////
//====================================================================
// Script - gf_dw2excel ( datawindow adw_data, string as_reptitle )
// [Reason]: 在PB中保存EXCEL文件
//--------------------------------------------------------------------
// [MODIFIED By]: DoItNow Date: 2003.05.28
//====================================================================
string sFileName, sFile
integer value
value = GetFileSaveName("另存为",sFileName, sFile,"xls","Excel文件 (*.xls),*.xls" )
IF value = 1 THEN
ole_object.ActiveWorkbook.saveas(sFileName)
ole_object.Displayalerts = FALSE //关闭在退出EXCEL时的保存提示
ole_object.Quit() //退出EXCEL
ELSE
messagebox("错误","保存文件出错,请手动保存")
ole_object.Visible = TRUE //显示ole应用服务
END IF
//-------MODIFIED END-------------------------------------------------
//////////////////////////////////////////////////////////////////////
SetPointer(oldpointer)
ole_object.DisconnectObject()
DESTROY ole_object
RETURN 1
参数说明见下面
/*========================================================================*/
// 函数名: gf_dw2excel
// 作用范围: public
/*------------------------------------------------------------------------*/
// 描述: 将数据窗口的数据传递至EXCEL表格中,列数有26列限制(一般情况已经够用了)
/*------------------------------------------------------------------------*/
// 参数:
// [value] datawindow adw_data 需要保存的数据窗口
// [value] string as_reptitle 表格标题
/*------------------------------------------------------------------------*/
// 返回值: LONG
/*------------------------------------------------------------------------*/
// 作者: xiaolihua 日期: 2003-05-20
// 修改: DoItNow 日期: 2003.06.06
/*========================================================================*/
CONSTANT Integer ppLayoutBlank = 12
Pointer oldpointer
OLEObject ole_object
ole_object = CREATE OLEObject
String s_english = "ABCDEFGHIJKMNLOPQRSTUVWXYZ"
Integer li_ret
//////////////////////////////////////////////////////////////////////
//====================================================================
// Script - gf_dw2excel ( datawindow adw_data, string as_reptitle )
// [Reason]: 由于再已经打开EXCEL的情况下,使用连接OLE时有时出错,所以改为
// 直接连接新的OLE 应用。
//--------------------------------------------------------------------
// [MODIFIED By]: DoItNow Date: 2003.06.06
//====================================================================
//li_ret = ole_object.ConnectToObject("","Excel.Application")
//IF li_ret <> 0 THEN
// //如果Excel还没有打开,则新建。
li_ret = ole_object.ConnectToNewObject("Excel.Application")
IF li_ret <> 0 THEN
MessageBox('打开错误','无法连接EXCEL!是否已经安装了EXCEL?错误号:' + String(li_ret))
RETURN 0
END IF
ole_object.Visible = FALSE //ole应用服务是否显示
//END IF
//-------MODIFIED END-------------------------------------------------
//////////////////////////////////////////////////////////////////////
oldpointer = SetPointer(HourGlass!)
ole_object.Workbooks.Add
Long ll_colnum,ll_rownum
String ls_value
String ls_objects,ls_obj,ls_objs[],ls_objtag[],ls_width[]
Long ll_pos,ll_len,ll_num = 0
//Excel表格中的行数为数据窗口行数+2
ll_rownum = adw_data.RowCount() + 2
String ls_colname
Integer i,j
Dec ld_width
ll_colnum = Long(adw_data.Object.DataWindow.Column.Count) //取得字段总数
ls_objtag[1] = "序号"
SetNull(ls_width[1])
i = 1
FOR ll_num = 1 TO ll_colnum
IF adw_data.DESCRIBE("#"+String(ll_num)+".Visible") = "1" THEN //列标志为nun_Visible的不显示
i = i+1
ls_obj = adw_data.DESCRIBE("#"+String(ll_num)+".name") //字段名称的实际存储值
ls_objs[i] = ls_obj
ls_objtag[i] = adw_data.DESCRIBE(ls_obj + "_t.text") //字段名称的显示值
ls_width[i] = adw_data.DESCRIBE(ls_obj + '.width') //每列的宽度
END IF
NEXT
ll_colnum = i //表格列数
//生成总标题
ole_object.Cells(1,1).Value = as_reptitle
ole_object.Range('A1').SELECT
ole_object.Selection.Font.Size = 24
ole_object.Selection.HorizontalAlignment = 3
ole_object.Range('A1:'+Mid(s_english,ll_colnum,1)+'1').select
ole_object.Range('A1:'+Mid(s_english,ll_colnum,1)+'1').Merge
//设置标题栏
FOR i = 1 TO ll_colnum
ls_value = ls_objtag[i]
ole_object.Cells(2,i).Value = ls_value
IF IsNull(ls_width[i]) THEN
ld_width = 12
ELSE
ld_width = Dec(ls_width[i])/35 //why devided by 35 ???
END IF
ole_object.Columns(i).ColumnWidth = ld_width
ole_object.Columns(i).HorizontalAlignment = 3
ole_object.Columns(i).Borders.LineStyle = 1
ole_object.Columns(i).Font.Bold = TRUE
NEXT
//添充实际数据到EXCEL
String column_name,ls_coltype
FOR i = 3 TO ll_rownum
ole_object.Cells(i,1).Font.Bold = FALSE
ole_object.Cells(i,1).Value = i - 2
FOR j = 2 TO ll_colnum
column_name = ls_objs[j]
IF adw_data.DESCRIBE(column_name + '.type') = 'column' THEN
ls_value = adw_data.DESCRIBE("Evaluate('LookupDisplay("+column_name+")',"+String(i - 2)+")")
END IF
IF adw_data.DESCRIBE(column_name + '.type') = 'compute' THEN
ls_value = adw_data.DESCRIBE("Evaluate('" + adw_data.DESCRIBE(column_name + '.expression') + "',"+String(i - 2)+")")
END IF
ls_coltype = adw_data.DESCRIBE(column_name+'.coltype')
IF Pos(Upper(ls_coltype),"CHAR") > 0 THEN //对字符型数据处理
ole_object.Cells(i,j).NumberFormat = "@"
END IF
ole_object.Cells(i,j).Font.Bold = FALSE
ole_object.Cells(i,j).Value = ls_value
NEXT
NEXT
//////////////////////////////////////////////////////////////////////
//====================================================================
// Script - gf_dw2excel ( datawindow adw_data, string as_reptitle )
// [Reason]: 在PB中保存EXCEL文件
//--------------------------------------------------------------------
// [MODIFIED By]: DoItNow Date: 2003.05.28
//====================================================================
string sFileName, sFile
integer value
value = GetFileSaveName("另存为",sFileName, sFile,"xls","Excel文件 (*.xls),*.xls" )
IF value = 1 THEN
ole_object.ActiveWorkbook.saveas(sFileName)
ole_object.Displayalerts = FALSE //关闭在退出EXCEL时的保存提示
ole_object.Quit() //退出EXCEL
ELSE
messagebox("错误","保存文件出错,请手动保存")
ole_object.Visible = TRUE //显示ole应用服务
END IF
//-------MODIFIED END-------------------------------------------------
//////////////////////////////////////////////////////////////////////
SetPointer(oldpointer)
ole_object.DisconnectObject()
DESTROY ole_object
RETURN 1
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询