Из Access в Excel и обратно Access

[alex shestov]

А я тебе обновляю столбец на данные
Как оно, я же переживаю!!!

Игорь, а вот тут нет ошибки?

Set AppExl = GetObject(, "Excel.Application.10") 'Excel.Application.10")

Пишет что не может создать такой объект.

[Igor_123]

Excel какой???
Set AppExl = GetObject(, "Excel.Application.10") - это для OfficeХР
для 2000
Set AppExl = GetObject(, "Excel.Application.9")
для 2003
Set AppExl = GetObject(, "Excel.Application.11")

[alex shestov]

Excel какой???
Set AppExl = GetObject(, "Excel.Application.10") - это для OfficeХР
для 2000
Set AppExl = GetObject(, "Excel.Application.9")
для 2003
Set AppExl = GetObject(, "Excel.Application.11")

Ага - 10.

Посмотри я сделал SELECT вот так:

Dim strSQL As String, rs As Recordset

strSQL = ("SELECT Doxod.Id, Doxod.Emitent, Doxod.Date, Doxod.DateNR, Doxod.Cupon_Value, Doxod.DiskontP, Doxod.PriseNKD FROM Doxod")

Но вот на это постоянно ругается -
Set rs = CurrentDb.OpenRecordset(strSQL)

Type mismatch (Error 13) Вот такими словами.
Не пойму никак причину.

[Igor_123]

Эта, ты эта таво

Пока затычка на метода MoveFirst. и в Экс не приходят данные

Как это затычка(это называеться заглушка) для MoveFirst. Без MoveFirst не будет работать и естественно не будут приходить данные, т.к. по данным, возможно, нет перемещения.

[Igor_123]

CurrentDb.OpenRecordset(strSQL) - возвращает DAO.Recordset
f Dim strSQL As String, rs As Recordset - этот непонятно какой библиотеки DAO или ADO

Set rs = CurrentDb.OpenRecordset(strSQL) - как все просто, а я мучался

[alex shestov]

Эта, ты эта таво

Пока затычка на метода MoveFirst. и в Экс не приходят данные

Как это затычка(это называеться заглушка) для MoveFirst. Без MoveFirst не будет работать и естественно не будут приходить данные, т.к. по данным, возможно, нет перемещения.

Да я понимаю.

[alex shestov]

CurrentDb.OpenRecordset(strSQL) - возвращает DAO.Recordset
f Dim strSQL As String, rs As Recordset - этот непонятно какой библиотеки DAO или ADO

Set rs = CurrentDb.OpenRecordset(strSQL) - как все просто, а я мучался

Теперь я что-то запутался.
Set rs = CurrentDb.OpenRecordset(strSQL) Все равно не работает, как быть то?

[Igor_123]

Код: Выделить всё

Private Sub Кнопка0_Click()
'On Error GoTo Err_Кнопка0_Click

  '  Screen.PreviousControl.SetFocus
'   DoCmd.FindNext
'Call NewControls
'Call RunExcel(DoCmd)
Dim AppExl As Excel.Application
Dim wb As Excel.Workbook
Dim rs As DAO.Recordset
Dim fl As Boolean
Dim i As Long, j As Long
i = 1
fl = True
Set AppExl = GetObject(, "Excel.Application.10") 'Excel.Application.10")
If AppExl Is Nothing Then
    Set AppExl = CreateObject("Excel.Application")
    If AppExl Is Nothing Then
        Err.Raise vbError + 1, , "Нет Excel'я, нет работы!"
        Exit Sub
    End If
    AppExl.Visible = True
    fl = False
End If
Set wb = AppExl.Workbooks.Add
If wb Is Nothing Then
    Err.Raise vbError + 1, , "Нет книги, нет работы!"
    Exit Sub
End If
Dim strSQL As String
'Вот здесь нужно сделать селект из таблицы с данными
'rs.Open "SELECT Doxod.Id, Doxod.Emitent, Doxod.Date, Doxod.DateNR, Doxod.Cupon_Value, Doxod.DiskontP, Doxod.PriseNKD FROM Doxod", _
'    CurrentDb.Connection
strSQL = ("SELECT Doxod.Id, Doxod.Emitent, Doxod.Date, Doxod.DateNR, Doxod.Cupon_Value, Doxod.DiskontP, Doxod.PriseNKD FROM Doxod")

Set rs = CurrentDb.OpenRecordset(strSQL)

'Set rs = DoCmd.RunSQL("SELECT Doxod.Id, Doxod.Emitent, Doxod.Date, Doxod.DateNR, Doxod.Cupon_Value, Doxod.DiskontP, Doxod.PriseNKD FROM Doxod")
rs.MoveFirst
With wb.Sheets(1)
    While Not rs.EOF
'        Вот здесь если j с 0, тогда rs.Fields.Count-1
        For j = 1 To rs.Fields.Count
            .Cells(i, j).Value = rs.Fields(j - 1).Value
        Next j
'       j - 2 - это столбец для формулы расчета
        .Cells(i, j - 2).FormulaR1C1 = "=RC[-1]/(1+(R1C" & CStr(j) & "/100))^(RC[-2]/365)"
        rs.MoveNext
        i = i + 1
    Wend
    .Cells(i, j - 2).FormulaR1C1 = "=SUM(R[-" & CStr(i - 1) & "]C:R[-1]C)"
    .Cells(i, j - 1).FormulaR1C1 = "=R[-1]C-RC[-1]"
    .Cells(i, j - 1).GoalSeek Goal:=0, ChangingCell:=.Cells(1, j) ' Range("H2")
   
    rs.MoveFirst
    i = 1
    While Not rs.EOF
        rs.Edit
        rs.Fields("DiskontP").Value = .Cells(i, j - 2).Value
        rs.Update
        rs.MoveNext
        i = i + 1
    Wend
End With
wb.Close False
Set wb = Nothing
If Not fl Then
    AppExl.Quit
End If
Set AppExl = Nothing

'Exit_Кнопка0_Click:
'    Exit Sub

'Err_Кнопка0_Click:
'    MsgBox Err.Description
'    Resume Exit_Кнопка0_Click
   
End Sub

Вот в referensax подключи
Library DAO
D:\Program Files\Common Files\Microsoft Shared\DAO\dao360.dll
Microsoft DAO 3.6 Object Library

Ну и подправь возвращаемый результат. Какой тебе надо
Удачи

[alex shestov]

To Igor!!!!

Спасибо огромное!!! Блин, ты только знал Сколько я с этим намучался...

Еще раз спасибо!!!

[Igor_123]

Да не за что.
Хоть сам немножко вспомнил акцес

[alex shestov]

Да не за что.
Хоть сам немножко вспомнил акцес

:):) Да уж...такие как я - не дадут забыть и забыться

[Igor_123]

alex shestov

[alex shestov]

alex shestov

Игорь, а как можно подправить код чтобы расчет можно было сделать не только для одного эмитента?

Вот если так будет табличка выглядеть?