Вот нашёл кое-что в запаснике:

===========

Вот текст достаточно универсальной функции для Access, которая загружает данные из таблицы Excel. Работает довольно медленно в силу поячеечного обращения к экселю.

'Процедура ЗагрузкаИзExcel

'Загрузка данных с листа Excel в соответствующую по структуре таблицу с указанием

'номера первой строки, содержащей данные. Загрузка ведется до конца диапозона

'параметры:

'Таблица - имя таблицы в которую будут загружаться данные

'Файл - полное имя файла (с путем) рабочей книги Excel

'Лист - имя листа Excel

'ПервСтрока - номер первой строки, содержащей данные

Function ЗагрузкаИзExcel(Таблица As String, Файл As String, Лист, ПервСтрока As Long)

    Dim app, wb, rst As New ADODB.Recordset, i As Long, j As Integer

    On Error GoTo ErrorHandler

    Set app = CreateObject("Excel.Application")

    Set wb = app.Workbooks.Open(Файл)

    rst.Open Таблица, CurrentProject.Connection, adOpenStatic, adLockOptimistic

    With wb.Worksheets(Лист)

        For i = ПервСтрока To .UsedRange.Rows.Count

            rst.AddNew

            For j = 1 To rst.Fields.Count    'Форматы таблиц должны совпадать!

                rst.Fields(j - 1) = .Cells(i, j)

            Next j

        Next i

    End With

    rst.Update

    rst.Close

    wb.Close

    GoTo Done

ErrorHandler:

    MsgBox "Ошибка при загрузке. Ряд " & i & " Столбец " & j

Done:

    Set rst = Nothing

    Set wb = Nothing

    Set app = Nothing

End Function

 

 

mastadon

17.04.2007, 16:05

можно с помощью функции если определить значения, а потом копировать и вставить (как значения) на старое место

 

 

AlexeyVik

18.04.2007, 13:09

mikle, задача была с точностью наоборот, из Excel    'я передать в Access.

 

Вот основная часть кода "Private Sub Worksheet_Change(ByVal Target As Range)"

.................

Dim Baza As Database, RS As Recordset, rs1 As Recordset

Set Baza = OpenDatabase(ThisWorkbook.Path & "\имя.mdb", False)    ' можно указать в кавычках полный путь к базе'

Set RS = Baza.OpenRecordset("Имя_таблицы", dbOpenDynaset)

Kod = Sheets("имя_листа_книги").Range("ячейка_содержащая _код")

QryStr = "SELECT * FROM Имя_таблицы WHERE Имя_таблицы.поле =Kod"

Set QRY1 = Baza.CreateQueryDef("")

QRY1.Sql = QryStr

Set rs1 = QRY1.OpenRecordset(dbOpenDynaset)

 

Здесь добавить обработку ошибки возникающую при отсутствии такого кода.

Если такой код есть

rs1.Edit

rs1.Fields("поле") = Target

rs1.Update

если -нет

RS.AddNew

RS.Fields("имя_поля_таблицы") = Sheets("имя_листа_книги").Range("ячейка_содержащая_код")

RS.Fields("имя_поля_таблицы") = Sheets("имя_листа_книги").Range("ячейка_содержащая_значение")

RS.Update

конец если

Baza.Close

Set RS = Nothing

Set rs1 = Nothing

...................

 

 

mikle

18.04.2007, 23:55

задача была с точностью наоборот, из Excel    'я передать в Access.Что от чего наоборот? ^_^

 

 

makody

20.04.2007, 15:06

Делаем в проекте ссылку на MS ADO 2.5. после чего можно использовать следующий код:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim cn          As ADODB.Connection

    Dim RS          As ADODB.Recordset

    Dim sPath       As String

 

    sPath = "C:\test.mdb"

 

    Set cn = New ADODB.Connection

    cn.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sPath & ";Persist Security Info=False"

    cn.Open

 

    RS = New ADODB.Recordset

 

    RS.Open "SELECT * FROM Table1 Where NameCell=" & Trim(Target.Name), cn, adOpenStatic, adLockOptimistic

 

    If RS.EOF Then

        RS.AddNew

        RS.Fields("NameCell").Value = Trim(Target.Name)

    End If

    RS.Fields("ValueCell").Value = Target.Value

    RS.Update

 

    RS.Close

    cn.Close

 

End Sub

 

и еще одна ссылка

http://www.delphikingdom.com/asp/answer.asp?IDAnswer=53209

 

 

есть заявлние в нем заполняются данные в ячейки (Фио,адрес,тел итд не) их нужно экспортировать в Access кнопкой на листе подскажите как сделать{/post}{/quote}

 

Вот вам пример

Sub ADD_MDB()

    Dim cn          As ADODB.Connection

    Dim cmd         As ADODB.Command

    Dim DBFullName  As String

    DBFullName = ThisWorkbook.Path & "\" & "base.mdb"

    Set cn = New ADODB.Connection

    cn.ConnectionString = "Provider= Microsoft.Jet.OLEDB.4.0;Data Source=" & DBFullName & ""

    cn.Open

 

    Set cmd = New ADODB.Command

    With cmd

        .ActiveConnection = cn

        .CommandText = "INSERT INTO TBL ( TBLname , TBLcount , TBLvalue ) VALUES (11111, '2222222', '33333333');"

        'TBL- Ваша таблица в скобках перечисляются Ваши поля в которые добавляются данные, во втрорых скобках (добавляемые значения)

    End With

    cmd.Execute

    cn.Close

    Set cn = Nothing

End Sub