将VB中MSHFlexGrid控件中的数据导入到Excel

机房收费系统中，不少窗体都要用到MSHFLexgrid控件来显示数据，并要求导入到Excel中，进而方便用户查询和操作数据。

原来在作品展中我们小组设计了一款小软件，是一款关于计票的软件，也用到了导入到Excel这一功能。所以说来也并不陌生了。

下面就为大家介绍三种将VB中数据导入到Excel 的方法。

首先是直接从Text或Label中导入。下面这种方法要自己事先建立一个Excel,优点是可以在指定的不同的磁盘里建立；不足之处是每次都要自己指定，比较麻烦，而且一旦程序完成，用户将无法建立其他新的工作表，也不得将规定建立的工作表改名。适用于开发者自己使用。

Private Sub LinkExcel_Click()
    Dim xlApp As Excel.Application       '定义一个新的Excel应用程序
    Dim xlBook As Excel.Workbook         '定义新的工作表
    Dim xlSheet As Excel.Worksheet       '定义新的工作簿

    Set xlApp = CreateObject("Excel.Application")      '实例化应用程序
    xlApp.Visible = True    '设置为可见
    Set xlBook = xlApp.Workbooks.Open(App.Path & "\选举结果1.xls")   '打开所建立的"\选举结果1.xls"工作表，这是自己手动建立的工作表
    Set xlSheet = xlBook.Worksheets(1)   '设置当前活动工作簿sheet1

    For i = 1 To n
        On Error Resume Next
        x = LblRank(i).Caption     '要显示的Lblrank中的数据
        y = TxtName(i).Text         '要显示的TxtName中的数据
        z = LblTickets(i).Caption   '要显示的LblTickets中的数据

        xlSheet.Cells(i,1).Value = x         '将要显示的数据定位到Excel单元格
        xlSheet.Cells(i,2).Value = y
        xlSheet.Cells(i,3).Value = z
    Next i

    xlApp.Application.Quit  '释放内存，将控制权交还给Excel
    Set xlApp = Nothing
End Sub

下面这一种就比较方便了，既可以自动建立Excel 工作表，也可以自动存储，存储位置可任意选择，限制很少；不足就是开发代码比较长。这种方法适用范围广，比较方便用户。

Private Sub txtOutPut_Click()
    Dim objExlApp As New Excel.Application '声明一个EXCEL应用程序
    Dim objExlBook As New Excel.Workbook   '声明一个EXCEL工作表
    Dim objExlSheet As New Excel.Worksheet '声明一个EXCEL工作簿
    Dim sFileName As String   '定义存储的文件名变量
    Dim lngRowsCount As Long  '声明行数变量
    Dim lngColumnsCount As Long  '声明列数变量
    Dim lngRow As Long         '声明单行
    Dim lngColumn As Long      '声明单列
    Dim strText As String      '声明保存的文件名变量
    
    '先判断MSFG1中有没有数据
    If MSFG1.Rows > 1 Then

        '另存到XLS文件
        '   设置“取消”为   True
        dlgSave.CancelError = False
        On Error Resume Next
        Set objExlApp = GetObject(,"Excel.Application")
        If Err.Number <> 0 Then
            Set objExlApp = CreateObject("Excel.Application")
        End If
        '错误处理
        On Error GoTo ErrHandler
        '保存对话框处理
        dlgSave.Filter = "Excel文件(*.xls)|*.xls|所有文件|*.*" '文件类型
        dlgSave.FileName = "杨建" & Format(Now,"yyyy-mm-dd") & ".XLS" '文件名
        dlgSave.ShowSave

        '在Excel中增加一个工作簿
        Set objExlBook = objExlApp.Workbooks.Add
        '实例化一个表单，并使其成为Excel的活动工作表单
        Set objExlSheet = objExlBook.Worksheets(1)

        '设置要使用的工作表，使其可见，并实例化EXCEL工作表单
        objExlApp.Visible = True
        objExlApp.ScreenUpdating = True
        objExlApp.DisplayAlerts = True
        Set objExlSheet = objExlBook.Sheets(1)

        lngRowsCount = MSFG1.Rows
        lngColumnsCount = MSFG1.Cols
        
        '导入数据
        For lngRow = 1 To lngRowsCount
            For lngColumn = 1 To lngColumnsCount
                strText = MSFG1.TextMatrix(lngRow - 1,lngColumn - 1)
                If IsNull(strText) = False And strText <> "" Then
                    objExlSheet.Cells(lngRow,lngColumn) = strText
                End If
            Next lngColumn
        Next lngRow

        objExlApp.Visible = True
        sFileName = dlgSave.FileName  '导出文件的文件名与保存时的文件名相同
         objExlSheet.SaveAs sFileName  '设置保存时的文件名

         objExlApp.Application.Quit  '终止Excel程序运行
         Set objExlSheet = Nothing   '释放内存里的变量，交还控制给Excel

        Set objExlBook = Nothing
        Set objExlApp = Nothing
        'objExlBook.Close
        MsgBox "文件已生成,在:" & sFileName  '提示文件生成及保存的路径

    Else
        MsgBox "没有可导出的数据，请先进行查询！"
    End If

ErrHandler:
    Exit Sub
End Sub

第三种方法就是自己定义一个导入到Excel的函数，到时候直接调用就可以了。函数的定义方法用很多种，就不在此为大家过多叙述了，举一个例子即可。

Public Sub ExportToExcel() '导出数据到excel      
    On Error Resume Next  
    Dim oExcel As Excel.Application  
    Dim obook As Excel.Workbook  
    Dim objExlSht As Excel.Worksheet  
      
    Dim listrst() As Variant  
    Dim X,Y As Long  
    Dim i,n As Integer  
      
    Set oExcel = New Excel.Application  
    Set obook = oExcel.Workbooks.Add  
    Set objExlSht = obook.ActiveSheet  
      
    X = myflexgrid.Rows  
    Y = myflexgrid.Cols  
      
    ReDim listrst(X,Y)  
        
      For i = 0 To myflexgrid.Rows - 1  
         For n = 0 To myflexgrid.Cols - 1  
             listrst(i,n) = Trim(myflexgrid.TextMatrix(i,n))  
           Next  
     Next  
          
        DoEvents  
            With objExlSht  
                   oExcel.Intersect(.Range(.Rows(1),.Rows(X)),.Range(.Columns(1),.Columns(Y))).Value = listrst  
      
             End With  
         oExcel.Visible = True  
         oExcel.Interactive = True  
End Sub

当然，还有其他方法可以实现该功能，大家可以继续去深入探索，找到适合自己的高效快捷方便的方法，本次就先介绍到这里。

将VB中MSHFlexGrid控件中的数据导入到Excel

相关推荐