• 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

  • 相关阅读:
    POJ 2018 二分
    873. Length of Longest Fibonacci Subsequence
    847. Shortest Path Visiting All Nodes
    838. Push Dominoes
    813. Largest Sum of Averages
    801. Minimum Swaps To Make Sequences Increasing
    790. Domino and Tromino Tiling
    764. Largest Plus Sign
    Weekly Contest 128
    746. Min Cost Climbing Stairs
  • 原文地址:https://www.cnblogs.com/swallow123/p/5199920.html
Copyright © 2020-2023  润新知