如何在VB中调用EXCEL，并打开一个已经存在EXCEL的文件？（50分）

Question

如何在VB中调用EXCEL，并打开一个已经存在EXCEL的文件？

Answer 1

Dim xlApp As New Excel.Application
    Set xlBook = xlApp.Workbooks().Open(Qpath & "dat\ndrwb.xls")
    xlApp.Application.Visible = True
    Set xlApp = Nothing '"交还控制给Excel
    Set xlBook = Nothing

Answer 2

http://community.csdn.net/Expert/topic/2972/2972741.xml?temp=9.525698E-02

Answer 3

Option ExplicitDim excelApp As New Excel.ApplicationPrivate Sub Form_Load()
                
        excelApp.Workbooks.Open App.Path & "\a.xls"
        
        excelApp.Visible=TrueEnd Sub
Private Sub Form_UnLoad()
        set excelApp=Nothing
End Sub

Answer 4

偶写的调用EXECL打印模块：
Option ExplicitDim uObjExcel    As New Excel.Application   '模块级打印对象：EXCEL对象'窗体LOAD
'---------------------------------------------------------
Private Sub Form_Load()
       
    Set uObjExcel = New Excel.ApplicationEnd Sub
'调用EXCEL进行医保汇总对帐单的打印
'---------------------------------------------------------
Private Sub LoadDataToExcel()
    
    On Error GoTo ErrLiner
    
    Dim intRow    As Integer
    Dim intCol    As Integer
    Dim intCount  As Integer
    Dim intTemp   As Integer
    
    Dim strFName  As String
    Dim strTemp1   As String
    Dim strTemp2   As String
    
    Dim strSql    As String
    Dim rsTemp    As ADODB.Recordset
    
    strFName = App.Path & "\PrtSet.ini"
    
    '初始化excel文档对象
    If IsNull(uObjExcel) Then Set uObjExcel = New Excel.Application
    uObjExcel.Application.Workbooks.Open FileName:=App.Path & "\Report\DZD.xls"    ', ReadOnly:=True
    
    '打印数值从第strTemp1行开始填入，第x列到第y列
    If GetPrtSet(strFName, "Content", "Row", strTemp1) = False Then Exit Sub
    
    '开始第 intRow行的数据插入
    intRow = CInt(strTemp1)
    intTemp = 1      '记录集字段值从第一列开始取
    
    '获取非长期门诊病人就诊人次[这在每个月的统计当中总是存在的]
    strSql = "Select * From tbDS_DayCountTmp " & _
             "Where tbDS_DayCountTmp.InsureCode in " & _
             "(Select InsureCode From  TBDS_PRESCRIPTION Where SpecFlag='0')"
    Set rsTemp = DbCn.Execute(strSql, 2)
    intCount = rsTemp.RecordCount
    
    strSql = "Select " & intTemp & " as XuHao," & intCount & " as RenCi,'定点药店购药' as LeiBie," & _
             "sum(Cost) as cost,sum(PerinfactPay) as PerInfactPay,sum(AddMoney) as AddMoney," & _
             "sum(BasePay) as BasePay,sum(BigIllPay) as BigIllPay,sum(OfficePay) as OfficePay " & _
             "From tbDS_DayCountTmp " & _
             "Where InsureCode in(Select InsureCode From TBDS_PRESCRIPTION Where SpecFlag='0')"
    Set rsTemp = DbCn.Execute(strSql, 2)
    
    If Not rsTemp.EOF Then
        If GetPrtSet(strFName, "Content", "StartCol", strTemp1) = False Then Exit Sub
        If GetPrtSet(strFName, "Content", "EndCol", strTemp2) = False Then Exit Sub
        For intCol = CInt(strTemp1) To CInt(strTemp2)
            uObjExcel.Application.Worksheets(1).Cells(intRow, intCol).Value = rsTemp.Fields(intTemp - 1)
            intTemp = intTemp + 1
        Next
        
        intRow = intRow + 1            '开始第intRow+1行的数据插入
    End If
    
    intTemp = 1      '记录集字段值从第一列开始取
    
    '获取长期门诊病人就诊人次[这在每个月的统计当中有可能是不存在的]
    strSql = "Select * From tbDS_DayCountTmp " & _
             "Where tbDS_DayCountTmp.InsureCode in " & _
             "(Select InsureCode From  TBDS_PRESCRIPTION Where SpecFlag='1')"
    Set rsTemp = DbCn.Execute(strSql, 2)
    intCount = rsTemp.RecordCount
    
    If intCount > 0 Then
    
        strSql = "Select " & intTemp & " as XuHao," & intCount & " as RenCi,'特殊门诊' as LeiBie," & _
                 "sum(Cost) as cost,sum(PerinfactPay) as PerInfactPay,sum(AddMoney) as AddMoney," & _
                 "sum(BasePay) as BasePay,sum(BigIllPay) as BigIllPay,sum(OfficePay) as OfficePay " & _
                 "From tbDS_DayCountTmp " & _
                 "Where InsureCode in(Select InsureCode From TBDS_PRESCRIPTION Where SpecFlag='1')"
        Set rsTemp = DbCn.Execute(strSql, 2)        If GetPrtSet(strFName, "Content", "StartCol", strTemp1) = False Then Exit Sub
        If GetPrtSet(strFName, "Content", "EndCol", strTemp2) = False Then Exit Sub
        For intCol = CInt(strTemp1) To CInt(strTemp2)
            uObjExcel.Application.Worksheets(1).Cells(intRow, intCol).Value = rsTemp.Fields(intTemp - 1)
            intTemp = intTemp + 1
        Next
        
    End If
''    uObjExcel.Application.Workbooks(1).SaveAs FileName:=App.Path & "\Report\DZD.xls"
    
    With uObjExcel.Application.Workbooks(1)
        If .Saved = False Then .Saved = True
    End With
    
    uObjExcel.Visible = True
    
    '(From, To, Copies, Preview, ActivePrinter, PrintToFile, Collate, PrToFileName)
    uObjExcel.ActiveSheet.PrintOut 1, 1, 3, True       '预览打印
    
    Set rsTemp = Nothing:    Exit Sub
    
ErrLiner:
    Debug.Print Err.Description & Err.Number
    
    If Not IsNull(rsTemp) Then Set rsTemp = Nothing
    
 End Sub