是否可以使用ADO加载ActiveX控件的值?

时间:2018-03-27 10:08:27

标签: excel vba excel-vba

我在Excel文档中有以下代码,我们称之为Workbook1

' Extract data from a workbook without opening it in Excel.
' Returns a multidimensional array as a Variant
'
' 30-Dec-2007, working in Excel 2000-2007
'
' http://www.rondebruin.nl/ado.htm
Public Function GetData( _
    sourceFile As String, _
    SourceSheet As String, _
    SourceRange As String _
) As Variant
    Dim rsCon As Object
    Dim rsData As Object
    Dim szConnect As String
    Dim szSQL As String
    Dim data As Variant

    ' Create the connection string.
    If val(Application.Version) < 12 Then
        szConnect = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
                    "Data Source=" & sourceFile & ";" & _
                    "Extended Properties=""Excel 8.0;HDR=No"";"
    Else
        szConnect = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                    "Data Source=" & sourceFile & ";" & _
                    "Extended Properties='Excel 12.0;HDR=NO;IMEX=1';"
    End If

    If SourceSheet = "" Then
        ' workbook level name
        szSQL = "SELECT * FROM " & SourceRange$ & ";"
    Else
        ' worksheet level name or range
        szSQL = "SELECT * FROM [" & SourceSheet$ & "$" & SourceRange$ & "];"
    End If

    On Error GoTo SomethingWrong

    Set rsCon = CreateObject("ADODB.Connection")
    Set rsData = CreateObject("ADODB.Recordset")

    rsCon.Open szConnect
    rsData.Open szSQL, rsCon, 0, 1, 1

    data = rsData.GetRows
    GetData = TransposeArray(data)

    ' Check to make sure we received data and copy the data
    ' Clean up our Recordset object.
    rsData.Close
    Set rsData = Nothing
    rsCon.Close
    Set rsCon = Nothing
    Exit Function

SomethingWrong:
    Err.Raise 5, "", "The file name, Sheet name or Range is invalid of : " & sourceFile & "! Error"
    Exit Function
    On Error GoTo 0
End Function

我用它来加载单独文档(Workbook2)中的数据。这很好用,除了现在我需要访问Workbook2中的ActiveX控件,其定义如下:

enter image description here

有没有办法创建一个SQL语句来处理复选框的当前状态?

0 个答案:

没有答案