VB访问excel数据实例

【实例截图】

【核心代码】

Sub GetExcel()
Dim MyXL As Object  '用于存放Microsoft Excel 引用的变量。
Dim ExcelWasNotRunning As Boolean '用于最后释放的标记。

    On Error Resume Next  '延迟错误捕获。
    
    '不带第一个参数调用Getobject函数将返回对该应用程序的实例的引用。
    '如果该应用程序不在运行，则会产生错误。
    Set MyXL = GetObject(, "Excel.Application")
    If Err.Number <> 0 Then ExcelWasNotRunning = True
    Err.Clear '如果发生错误则要清除 Err 对象。
    
    '检测 Microsoft Excel。如果 Microsoft Excel 在运行，则将其加入运行对象表。
    DetectExcel      '该过程检测并登记正在运行的 Excel
    
    '设置其 Application 属性，显示 Microsoft Excel。
    '然后使用 MyXL 对象引用的 Windows 集合,显示包含该文件的实际窗口。
    MyXL.Application.Visible = True
    MyXL.Parent.Windows(1).Visible = True
    
    '如果在启动时，Microsoft Excel 的这份副本不在运行中，
    '则使用 Application 属性的 Quit 方法来关闭它。
    '注意，当试图退出 Microsoft Excel 时，
    '标题栏会闪烁，并显示一条消息询问是否保存所加载的文件。
    If ExcelWasNotRunning = True Then
        MyXL.Application.Quit
    End If
    Set MyXL = Nothing  '释放对该应用程序和电子数据表的引用。
End Sub

'该过程检测并登记正在运行的 Excel。
Sub DetectExcel()
Const WM_USER = 1024
Dim hwnd As Long

'如果 Excel 在运行，则该 API 调用将返回其句柄。
    hwnd = FindWindow("XLMAIN", 0)
    If hwnd = 0 Then  '0 表示没有 Excel 在运行。
        Exit Sub
    Else
        'Excel 在运行，因此可以使用 SendMessage API'函数将其放入运行对象表。
        SendMessage hwnd, WM_USER 18, 0, 0
    End If
End Sub



Private Sub cmdRun_Click()
Dim intLow, intCol As Integer

    Call GetExcel
    Set xlapp = GetObject(App.Path "\Book1.XLS")  '打开模扳文件
    xlapp.Parent.Windows(1).Visible = True          '使父窗体可见
    Set xlsheet = xlapp.Application.Worksheets(1)     '当前工作簿的第一页
    For intLow = 7 To 28 '这段代码是将整数1到29写入单位格中，实际应用时可
        For intCol = 1 To 29           '读数据文件并按要求写入表格中
            xlsheet.Cells(intLow, intCol) = intCol   '当前工作簿第一页的第I行第J列
        Next intCol
    Next intLow

    With xlsheet                                '设置边框为实线
        .Range(.Cells(7, 1), .Cells(28, 29)).Borders.LineStyle = xlContinuous
    End With

    xlsheet.SaveAs App.Path & "\w2.xls"          '按指定文件名存盘
    
    ' 引用当前工作簿的第二页
    Set xlsheet = xlapp.Application.Worksheets(2)
    xlsheet.Cells(7, 2) = 789    '在第二页的第7行第2列写入789
    Set xlbook = xlapp.Application.Workbooks.Add '新建一空白工作簿
End Sub