TopPicLogo TopPicText

MS Excel - Берём значения из пары ячеек в форму MS Access

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

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

Private Sub GetDataFrom_ExcelWB(wbSoursePath As String)
'Аргументы:
'   wbSoursePath  = Исходный файл
'--------------------------------------------------------------------
Dim objExcelApp As Object
Dim objWorkbook 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
'--------------------------------------------------------------------
On Error GoTo GetDataFrom_ExcelWB_Err

    If wbSoursePath = "" Then
        MsgBox "Путь не указан!", vbCritical
        Exit Sub
    End If
    
    If Dir(wbSoursePath) = "" Then
        MsgBox "Путь не указан!", vbCritical
        Exit Sub
    End If
    
    Set objExcelApp = CreateObject("Excel.Application")
    Set objWorkbook = objExcelApp.Workbooks.Open(wbSoursePath)
    'Set objWorkheet = objWorkbook.Worksheets(1)

'Берём данные (из листа с индексом 1):
'--------------------------------------------------------------------
    With objWorkbook.Worksheets(1) 'Лист 1 (а может быть и несколько)
        
        'Берём значение формулы - а не то что отображается в ячейке!
        'Но можно было и так: .Range("F6").Value
        v = .Range("F6").FormulaR1C1
        Me!txtValueFromF6 = v
        
        'Наоборот - берём значение ячейки, а не формулу
        v = .Range("H11").Value
        Me!txtValueFromH11 = CCur(v)
    
    End With
'--------------------------------------------------------------------

    'objWorkbook.Save 'Сохраняем РЕЗУЛЬТАТ (если юыли изменения в файле)...
    'DoEvents
    
GetDataFrom_ExcelWB_Bye:  'Закрываем всё!
    On Error Resume Next
    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


Picture




Скачать

MSA-2003 Пример


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