VBA, MS Access MS Access в примерах

MS Excel - Берём значения (формулы) из ячеек

Простой пример:
Берём значения пары ячеек из книги MS Excel и вставляем в форму (или куда угодно)

Код из примера:

Private Sub GetDataFrom_ExcelWB(wbSoursePath As String)
'Аргументы:
'   wbSoursePath  = Исходный файл
'--------------------------------------------------------------------
Dim objExcelApp As Object
Dim objWorkbook As Object
Dim objWorkSheet As Object
' ... или так: (Если сылка на [MS Excel XX Object LIB]  установлена.)
'Dim objExcelApp As Excel.Application 'Требуется ссылка на MS Excel XX Object LIB
'Dim objWorkbook As Excel.Workbook    'Требуется ссылка на MS Excel XX Object LIB
'Dim objWorkSheet As Excel.WorkSheet  'Требуется ссылка на MS Excel XX Object LIB

Dim s$, vVal As Variant
'--------------------------------------------------------------------
On Error GoTo GetDataFrom_ExcelWB_Err

   
    If Dir(wbSoursePath) = "" Then
        MsgBox "Путь не указан!", vbCritical
        Exit Sub
    End If
    
    Set objExcelApp = CreateObject("Excel.Application")
    Set objWorkbook = objExcelApp.Workbooks.Open(wbSoursePath)
    Set objWorkSheet = objWorkbook.WorkSheets(2) 'Второй лист (не первый!)

'Берём данные (из листа с индексом 2):
'--------------------------------------------------------------------
    With objWorkSheet 'Лист 2 (а может быть и несколько)
        Debug.Print "Имя листа: " & objWorkSheet.Name
        'Берём значение ячейки (а не формулу)
        s = "D9"
        vVal = .Range(s).Value
        Debug.Print s & ": " & vVal
        'Me!txtValueFromH11 = CCur(vVal) 'Переносим данные в тек. форму
        
        'Берём значение формулы - а не то что отображается в ячейке!
        s = "E9"
        vVal = .Range(s).FormulaR1C1
        Debug.Print s & ": " & vVal
        'Me!txtValueFromF6 = vVal  'Переносим данные в тек. форму

    End With
'--------------------------------------------------------------------

    'objWorkbook.Save 'Сохраняем РЕЗУЛЬТАТ (если были изменения в файле)...
    'DoEvents
    
GetDataFrom_ExcelWB_Bye:  'Закрываем всё!
    On Error Resume Next
    objExcelApp.Visible = True

    Set objWorkSheet = Nothing
    'objWorkbook.Close
    Set objWorkbook = Nothing
    'objExcelApp.Quit
    Set objExcelApp = Nothing
    
    Err.Clear
    Exit Sub

GetDataFrom_ExcelWB_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure GetDataFrom_ExcelWB", vbCritical, "Error!"
    Resume GetDataFrom_ExcelWB_Bye
End Sub



Ещё вариант:

Private Sub GetDataFrom_ExcelWB(wbSoursePath As String)
'Аргументы:
'   wbSoursePath  = Исходный файл
'--------------------------------------------------------------------
Dim objExcelApp As Object
Dim objWorkBook As Object
Dim objWorkSheet As Object
Dim s$, sTmp$, iVal%, vVal As Variant
'--------------------------------------------------------------------
On Error GoTo GetDataFrom_ExcelWB_Err

   
    If Dir(wbSoursePath) = "" Then
        MsgBox "Путь не указан!", vbCritical
        Exit Sub
    End If
    
    Set objExcelApp = CreateObject("Excel.Application")
    Set objWorkBook = objExcelApp.Workbooks.Open(wbSoursePath)
    Set objWorkSheet = objWorkBook.WorkSheets(2) 'Второй лист (не первый!)

'Берём данные (из листа с индексом 2):
'--------------------------------------------------------------------
    With objWorkSheet 'Лист 2 активен !
        For iVal = 78 To 90 '"AN" To "AZ" ..."BW"
            'Берём значение формулы - а не то что отображается в ячейке!
            s = "A" & Chr$(iVal) & "6"
            vVal = .Range(s).FormulaR1C1
            Debug.Print s & ": " & vVal
        Next iVal
    End With
'--------------------------------------------------------------------
    
GetDataFrom_ExcelWB_Bye:  'Закрываем всё!
    On Error Resume Next
    objExcelApp.Visible = True

    Set objWorkSheet = Nothing
    'objWorkbook.Close
    Set objWorkBook = Nothing
    'objExcelApp.Quit
    Set objExcelApp = Nothing
    
    Err.Clear
    Exit Sub

GetDataFrom_ExcelWB_Err:
    MsgBox "Error " & Err.Number & vbCrLf & Err.Description & vbCrLf & _
    "in procedure GetDataFrom_ExcelWB", vbCritical, "Error!"
    Resume GetDataFrom_ExcelWB_Bye
End Sub

Назад ToTop
L.E. 19.08.2019
Рейтинг@Mail.ru