CSDN首页 空间 新闻 论坛 Blog 下载 读书 网摘 搜索 .NET Java 视频 接项目 求职 在线学习 买书 程序员 通知
山寨机中的战斗机! 程序优化工程师到底对IT界有没有贡献
CSDN社区
搜索 收藏 打印 关闭
CSDN社区 >  VB >  基础类

如可把mshflexgrid 的内容直接导入到execl表格中去?急急!!!

楼主normandj(norman)2002-05-30 10:10:30 在 VB / 基础类 提问

我要把mshflexgird中text的内容直接导入execl表格中去,要求不能以文本文件作为过度,如果可以的话shell一类的语句能做到的话,请告诉我方法,如果有别的方法实现,我也想听听方法。在线等待。 问题点数:20、回复次数:8Top

1 楼SuperZhou(2004↑)回复于 2002-05-30 10:16:54 得分 10

Public   Sub   ExportToExcel(ctlMshg   As   MSHFlexGrid,   rstRecord   As   ADODB.Recordset,   _  
                                                    strReportCaption   As   String,   strReportHead   As   String,   _  
                                                    strReportTail   As   String,   strFileName   As   String,   blnCount   As   Boolean)  
      Dim   xlApp   As   Excel.Application                 '定义Excel应用对象  
      Dim   xlBook   As   Excel.Workbook                     '定义Excel工作簿对象  
      Dim   xlSheet   As   Excel.Worksheet                 '定义Excel工作表对象  
      Dim   i   As   Long,   j   As   Long,   k   As   Long,   l   As   Long  
      Dim   strTemp   As   String  
       
      On   Error   GoTo   ErrHandler  
      If   FileExists(strFileName)   Then  
          Kill   strFileName  
      End   If  
      Set   xlApp   =   New   Excel.Application  
      xlApp.SheetsInNewWorkbook   =   1  
      xlApp.Visible   =   False  
      Set   xlBook   =   xlApp.Workbooks.Add  
      Set   xlSheet   =   xlBook.ActiveSheet  
       
      k   =   rstRecord.AbsolutePage             '保存记录集的页位置  
      rstRecord.MoveFirst  
       
      l   =   ctlMshg.Cols  
      strTemp   =   "A1:"   &   Chr(65   +   l   -   1)   &   "1"  
      xlSheet.Range(strTemp).MergeCells   =   True  
      xlSheet.Range(strTemp).Value   =   strReportCaption  
      strTemp   =   "A2:"   &   Chr(65   +   l   -   1)   &   "2"  
      xlSheet.Range(strTemp).MergeCells   =   True  
      xlSheet.Range(strTemp).Value   =   strReportHead  
       
      For   i   =   0   To   l   -   1  
          xlSheet.Cells(3,   i   +   1).Value   =   ctlMshg.TextMatrix(0,   i)  
      Next   i  
     
      i   =   4  
      With   rstRecord  
          Do   Until   .EOF  
              For   j   =   0   To   l   -   1  
                  strTemp   =   rstRecord.Fields(j).Value  
                  xlSheet.Cells(i,   j   +   1).Value   =   IIf(blnCount,   strTemp,   "'"   &   strTemp)  
              Next  
              DoEvents  
              i   =   i   +   1  
              .MoveNext  
          Loop  
      End   With  
       
      If   blnCount   Then  
          xlSheet.Cells(i,   1).Value   =   "合计"  
          For   j   =   1   To   l   -   1  
              strTemp   =   "=SUM("   &   Chr(65   +   j)   &   4   &   ":"   &   Chr(65   +   j)   &   (i   -   1)   &   ")"  
              xlSheet.Cells(i,   j   +   1).Value   =   strTemp  
          Next   j  
          i   =   i   +   1  
      End   If  
       
      strTemp   =   "A"   &   i   &   ":"   &   Chr(65   +   l   -   1)   &   i  
      xlSheet.Range(strTemp).MergeCells   =   True  
      xlSheet.Range(strTemp).Value   =   strReportTail  
       
      xlSheet.SaveAs   strFileName                 '保存导出的Excel文件  
      xlApp.DisplayAlerts   =   False  
      xlBook.Close  
      xlApp.Quit                                                 '退出EXCEL  
      xlApp.DisplayAlerts   =   True  
      Set   xlApp   =   Nothing  
      If   k   >   0   Then  
          rstRecord.AbsolutePage   =   k             '恢复记录集的页位置  
      End   If  
      Exit   Sub  
       
  ErrHandler:  
      If   k   >   0   Then  
          rstRecord.AbsolutePage   =   k  
      End   If  
      MsgBox   "错误:"   &   Err.Description   &   "!",   vbExclamation,   "系统提示"  
  End   SubTop

2 楼_1_(该用户已封杀)回复于 2002-05-30 10:17:55 得分 0

最多一行一行的写了....  
   
  调用EXCEL对象Top

3 楼mornwoo(爱永恒伤离别)回复于 2002-05-30 10:26:11 得分 10

'将数据输出为excel文件  
  Private   Sub   s_OutToExcel()  
  Screen.MousePointer   =   vbHourglass  
  Dim   oXl   As   Excel.Application  
  Dim   oWb   As   Workbook  
  Dim   oWs   As   Excel.Worksheet  
  Dim   iA,   iB,   iC,   iD  
  Dim   bExcelRunning         'Excel是否已运行  
  Dim   flg   As   MSFlexGrid  
  Dim   sStr  
  On   Error   GoTo   Morn  
  bExcelRunning   =   True           '同首先用的GetObject一致:假设Excel已运行  
  Set   oXl   =   GetObject("",   "Excel.Application")  
  Set   oWb   =   oXl.Workbooks.Add  
  Set   oWs   =   oWb.Worksheets(1)  
  Set   flg   =   mOform.flg  
  With   oWs  
          For   iB   =   1   To   flg.Cols  
              .Cells(1,   iB).Value   =   flg.TextMatrix(0,   iB   -   1)  
          Next  
          For   iC   =   1   To   flg.Rows   -   1  
                  For   iB   =   1   To   flg.Cols  
                    sStr   =   Trim(flg.TextMatrix(iC,   iB   -   1))  
                    If   IsNumeric(sStr)   Then  
                          .Cells(iC   +   1,   iB).Value   =   sStr  
                    Else  
                          '截取尾部的数字  
                          If   IsNumeric(Right(sStr,   1))   Then   sStr   =   Left(sStr,   Len(sStr)   -   1)  
                          If   IsNumeric(Right(sStr,   1))   Then   sStr   =   Left(sStr,   Len(sStr)   -   1)  
                          .Cells(iC   +   1,   iB).Value   =   sStr  
                    End   If  
                     
                  Next  
          Next  
  End   With  
  oWs.Parent.Names.Add   "CostRange",   "="   &   "A1:B39"  
  sStr   =   App.Path   &   "\"   &   mOform.Caption   &   ".xls"  
  oWs.SaveAs   sStr  
  Screen.MousePointer   =   vbDefault  
  If   MsgBox("已将数据输出到Excel文件中!   现在打开该文件?",   vbQuestion   +   vbYesNo,   "已完成")   =   vbNo   Then  
        oXl.Quit  
  Else  
        oXl.Visible   =   True  
  End   If  
  Set   oXl   =   Nothing  
  Set   oWs   =   Nothing  
  Set   oWb   =   Nothing  
   
  Exit   Sub  
  Morn:  
  Select   Case   Err.number  
        Case   429  
            Set   oXl   =   GetObject("",   "Excel.Application")  
            bExcelRunning   =   False  
            Resume   Next  
        Case   1004  
            Screen.MousePointer   =   0  
            iA   =   MsgBox("发生了错误"   &   Err.number   &   ":   "   &   Err.Description,   vbExclamation   +   vbAbortRetryIgnore   +   vbDefaultButton3,   "错误")  
            If   iA   =   vbAbort   Then   Exit   Sub  
            If   iA   =   vbRetry   Then  
                Resume  
            Else  
                Resume   Next  
            End   If  
        Case   Else  
                  MornSubs.sub_ErrCenter   False  
  End   Select  
  End   Sub  
  Top

4 楼normandj(norman)回复于 2002-05-30 10:33:38 得分 0

Dim   xlApp   As   Excel.Application            
  说我用户定义类型未定义,  
  请问如何定义?Top

5 楼footballboy(郑创斌)回复于 2002-05-30 10:37:12 得分 0

工程-引用-Microsoft   Excel   X.0   Object   LibaryTop

6 楼SuperZhou(2004↑)回复于 2002-05-30 10:39:20 得分 0

要到工程->引用中选择Microsoft   Excel   9.0(或8.0)   Object   LibraryTop

7 楼hxhan(王寒)回复于 2002-05-30 10:44:16 得分 0

你可以这样定义:  
  如:Dim   xlApp   as   object      
  这样再继续执行就可以了。因为我刚刚用过,如你还有不明白的再问我,Top

8 楼mornwoo(爱永恒伤离别)回复于 2002-05-30 11:01:14 得分 0

补充:你的操作系统必须安装了excell,  
      而将来程序运行的环境下也必须安装有excell,  
  Top

相关问题

  • 如何将数据导入execl表格?请高手指点.
  • 求一个后台Execl导入,前台表格输入的ASP程序
  • .net做的表格怎样导入Excel表格中?
  • execl数据导入sql中
  • 导入EXECL数据问题?
  • 如何在vfp中导入excel表格数据?
  • 关于把数据导入excel表格的问题。请帮助!
  • 怎样把DBGrid全部导入Excel表格里?
  • 把MFLEXGRID的内容导入到Excel表格?
  • 怎样用ASP将Excel表格数据导入Oracle?

关键词

  • excel
  • rstrecord
  • xlsheet
  • ctlmshg
  • xlapp
  • strtemp
  • xlbook
  • 定义
  • strfilename
  • 对象

得分解答快速导航

  • 帖主:normandj
  • SuperZhou
  • mornwoo

相关链接

  • Visual Basic类图书
  • Visual Basic类源码下载

广告也精彩

反馈

请通过下述方式给我们反馈
反馈
提问
网站简介|广告服务|VIP资费标准|银行汇款帐号|网站地图|帮助|联系方式|诚聘英才|English|问题报告
北京创新乐知广告有限公司 版权所有, 京 ICP 证 070598 号
世纪乐知(北京)网络技术有限公司 提供技术支持
Copyright © 2000-2008, CSDN.NET, All Rights Reserved
GongshangLogo