zoukankan      html  css  js  c++  java
  • VB6.0 excel 导入和导出

     在工程中引用Microsoft Excel类型库

    因为office 版本的不同,在代码写完之后,去掉引用 Microsoft Excel 9.0 Object Library(EXCEL2000

    调用 excel 对象之前先创建

        比如:

       Dim xlApp As Object
        Set xlApp = CreateObject("Excel.Application")

    这样就可以避免因为版本的不同,出现问题了

    ---------------------------------------

    ------数据库导出EXCEL-------------

       On Error GoTo handles

          conn.ConnectionString = sqlconn '使用连接
           conn.CursorLocation = adUseClient
           conn.Open
           Set rst = conn.Execute(sqlstr)

         
    '    Dim xlApp As Excel.Application
    '
    '    Dim xlbook As Excel.Workbook
    '
    '    Dim xlsheet As Excel.Worksheet
        Dim xlApp As Object
        Dim xlbook As Object
        Dim xlsheet As Object
       
       
        Set xlApp = CreateObject("Excel.Application")
        Set xlbook = xlApp.Workbooks.Add 'Excel文件路径及文件名
        Set xlsheet = xlbook.Worksheets(1)

          If rst.RecordCount > 1 Then
           
            '获取字段名
            For i = 1 To rs.Fields.Count
           
              xlsheet.Cells(1, i) = rst.Fields(i - 1).Name
           
            Next i
           
            rst.MoveFirst '指针移动到第一条记录
            xlsheet.Range("A2").CopyFromRecordset rst '复制全部数据
           
            '释放结果集,命令对象 和连接对象
            Set rst = Nothing
            Set comm = Nothing
            Set conn = Nothing
           
           xlApp.DisplayAlerts = False
           xlApp.Save
           xlApp.Quit   '关闭Excel
           MsgBox "数据导出完毕!", vbInformation, "金蝶提示"
         
          End If
         
         

        Exit Sub
         
    handles:

         If Err.Number = 1004 Then
             xlApp.Quit   '关闭Excel
            Exit Sub
        Else
           If Err.Number <> 32577 Then
                   MsgBox "ErrCode:" & Err & " ErrDescription:" & Err.Description
           End If
           Exit Sub

        End If

    ----------------------------------------

    ''' Excel表格导出功能
    Private Sub Command2_Click()

       On Error GoTo handles
      
        Dim xlApp As Object
        Set xlApp = CreateObject("Excel.Application")
        Set exlBook = xlApp.Workbooks.Add 'Excel文件路径及文件名
       
       
            Dim i As Integer
            Dim j As Integer
            Dim k As Integer

            With VSFlexGrid1

                For i = 0 To .Rows - 1  '共有多少行
                  j = 0
                   For j = 0 To .Cols - 1 '共有多少列

                          xlApp.Sheets(1).Cells(i + 1, j + 1) = .TextMatrix(i, j)
                    
                  Next j
                Next i

            End With
           
           

        xlApp.DisplayAlerts = False
        'exlBook.Close True  '先保存修改再关闭工作簿
        xlApp.Save
        exlBook.Close True
        xlApp.Quit   '关闭Excel
        Exit Sub
       
    handles:

         If Err.Number = 1004 Then
             xlApp.Quit   '关闭Excel
            Exit Sub
        Else
           If Err.Number <> 32577 Then
                   MsgBox "ErrCode:" & Err & " ErrDescription:" & Err.Description
           End If
           Exit Sub
          
        End If

    End Sub

    '''EXCEL表格 导入功能

    Private Sub Command3_Click()
    'On Error Resume Next
     Dim fileadd As String

     CommonDialog1.Filter = "xls文件(*.xls)|*.xls" '选择你要的文件
     CommonDialog1.ShowOpen
     fileadd = CommonDialog1.FileName

     If fileadd <> "" Then '判断是否选择文件
        
        Dim xlApp1 As Object
        Dim xlSheet1 As Object
       
        Set xlApp1 = CreateObject("Excel.Application") '创建excel程序
        Set xlBook1 = xlApp1.Workbooks.Open(fileadd) '打开存在的Excel表格
        Set xlSheet1 = xlBook1.Worksheets(1) '设置活动工作表

        Dim lastCol As Integer
        Dim lastRow As Integer
       
        lastCol = xlSheet1.UsedRange.Columns.Count 'excel 表格列数
        lastRow = xlSheet1.UsedRange.Rows.Count 'Excel 表格行数

        '根据 EXCEL 表格中的行列数 确定 vsflexgrid 表的行列数
        VSFlexGrid1.Cols = lastCol + 1
        VSFlexGrid1.Rows = lastRow + 1


        For i = 0 To lastRow - 1

            For j = 1 To lastCol

                 VSFlexGrid1.Cell(flexcpText, i, j) = xlSheet1.Cells(i + 1, j).Value

            Next j

        Next i

        VSFlexGrid1.Refresh
        MsgBox "数据导入完毕", vbInformation, "提示"
       
     Else
     
        MsgBox "请选择文件", vbExclamation, "提示"

     End If
         VSFlexGrid1.Redraw = False '关闭表格重画,加快运行速度
     


    End Sub

  • 相关阅读:
    jquery获得option的值和对option进行操作
    laravel 在添加操作自动完成对时间保存修改
    laravel使用ajax
    mysql操作查询结果case when then else end用法举例
    Laravel框架数据库CURD操作、连贯操作总结
    laravel5.1关于lists函数的bug
    详解AngularJS中的filter过滤器用法
    javascript中的时间处理
    angularJs--$on、$emit和$broadcast的使用
    angularJs--<ui-select>
  • 原文地址:https://www.cnblogs.com/swallow123/p/5199920.html
Copyright © 2011-2022 走看看