Как передать данные в Excel из Access...

[Алёна]

В Аccess есть несколько таблиц и запросов.... данные из которых мне надо перенести в определенную ячейку Excel....

Для этого я открываю  Excel и ввожу данные в ячейку:

Код:

Private Sub Кнопка9_Click()

    Dim oApp As Object
    
    Set oApp = CreateObject("Excel.Application")
    With oApp
    .Visible = True
    .Workbooks.Open CurDir & "\Документ.xls"
    .ActiveSheet.Cells(1, 1).Value = 123
    End With
    
End Sub

Как мне вместо 123 поставить расчет из Аccess из разных таблиц:

например:
.ActiveSheet.Cells(1, 1).Value = Таблица1.Sum(колонка1)+Таблица2.Sum(колонка1)

[Алексей++]

помниться есть использование диапазона .Range , но точно не подскажу, потому как не ведаю

(в msdn сунулся - с трудом поддаётся поиску...)

[HandKot]

Алёна, может выполнить запрос и рузультат поместить в ячейку?
Или немного поподробнее, и лучше с небольшим примером

[RomCom]

Легче всего это сделать через SQL запросы.
Вот для примера взял базу "Борей":

Код:

Private Sub МойРасчет()
  Dim oApp As Object
  Dim SumRS As Recordset
  Dim s As Currency
    
    'запрос к 1-й базе
    Set SumRS = CurrentDb.OpenRecordset("select sum(Заказы.СтоимостьДоставки) from Заказы")
    s = SumRS.Fields(0).Value 'сохраняем сумму
    SumRS.Close
    'запрос ко 2-й базе
    Set SumRS = CurrentDb.OpenRecordset("select sum(Заказано.Цена*Заказано.Количество) from Заказано")
    s = s + SumRS.Fields(0).Value 'суммируем с предыдущим результатом
    SumRS.Close
    
    Set oApp = CreateObject("Excel.Application")
    With oApp
    .Visible = True
    .Workbooks.Open CurDir & "\Документ.xls"
    .ActiveSheet.Cells(1, 3).Value = s 'выводим в ячейку
    End With
End Sub

[RomCom]

По работе в Аccess есть хороший сайт http://www.hiprog.com/access/default.asp. Там много примеров, статей и уроков.

[Алёна]

Спасибо...............

[Алёна]

А теперь мне необходимо данные перенести в Word. Для этого я в документе создала текстовое поле в которое в последствии я должна вставить данные.

Код:

Private Sub Кнопка0_Click()
        Dim wda As Object
        
        
        Set wda = CreateObject("Word.Application")
        
        Set SumPS = CurrentDb.OpenRecordset("График")
        s = SumPS.Fields(0).Value
        SumPS.Close

        With wda
        .Visible = True
        .Documents.Open CurDir & "\ЕСН.doc"
        .Bookmarks("ТекстовоеПоле1").Select
        .Selection.TypeText Text:= s
         End With
 
End Sub

VBA мне выдаёт ошибку на строчку:
.Bookmarks("ТекстовоеПоле1").Select

Не пойму почему.........

[HandKot]

Алёна, вот так делал я, может пригодится

Код:

        Set wrd = CreateObject("Word.Application")
        wrd.Visible = True
        
        Set doc = wrd.Documents.Add(App.Path & "\Statement.rtf")
        
        'инициализируем поля
        SetDocVar doc, "CONTRACT_ID", " "
....
Private Function SetDocVar(doc As Object, strName As String, value As Variant)
    
    On Error GoTo EH
    
    doc.Variables(strName).value = value
    
    Exit Function
EH:
    doc.Variables.Add strName, value
    Exit Function
End Function

[RomCom]

а можно и так:

Код:

Private Sub Кнопка0_Click()
        Dim wda As Object
        Dim i As Integer, f As Object
        
        Set wda = CreateObject("Word.Application")
        
        Set SumPS = CurrentDb.OpenRecordset("График")
        s = SumPS.Fields(0).Value
        SumPS.Close

        With wda
        .Visible = True
        .Documents.Open CurDir & "\ЕСН.doc"
        For i = 0 To .ActiveDocument.InlineShapes.Count
         If .ActiveDocument.InlineShapes(i).OLEFormat.ProgId = "Forms.TextBox.1" Then
            Set f = .ActiveDocument.InlineShapes(i).OLEFormat.Object
            f.Text = s
         End If
        Next
        End With
 
End Sub

[Алёна]

 Теперь VBA не нравиться эта строчка:

 If .ActiveDocument.InlineShapes(i).OLEFormat.ProgId = "Forms.TextBox.1" Then

Он говорит, что запрашиваемый номер семейства не существует....

[RomCom]

Сори. Апшибочка

Код:

For i = 1 To .ActiveDocument.InlineShapes.Count

И еще раз сори. Этот код для элемента управления "Поле".
Для элемента формы "Текстовое поле" все гораздо проще.

Код:

Private Sub Кнопка0_Click()
        Dim wda As Object
        
        Set wda = CreateObject("Word.Application")
        
        Set SumPS = CurrentDb.OpenRecordset("График")
        s = SumPS.Fields(0).Value
        SumPS.Close

        With wda
         .Visible = True
         With .Documents.Open(CurDir & "\ЕСН.doc")
          .FormFields("ТекстовоеПоле1").result = s
         End With
        End With 
End Sub

Бес попутал 

[Алёна]

Продолжим..................

У меня есть таблица из которой я выбираю данные по определенному критерию

Код:

        
          Set rs = CurrentDb.OpenRecordset("select * from ВыборкаТ where Месяц =1")
          ss1 = rs.Fields(0).Value
          ii1 = rs.Fields(1).Value
          bl1 = rs.Fields(2).Value
          fs1 = rs.Fields(3).Value
          ns1 = rs.Fields(4).Value
          rs.Close
          
          Set rs = CurrentDb.OpenRecordset("select * from ВыборкаТ where Месяц =4")
          ss1 = rs.Fields(0).Value
          ii1 = rs.Fields(1).Value
          bl1 = rs.Fields(2).Value
          fs1 = rs.Fields(3).Value
          ns1 = rs.Fields(4).Value
          rs.Close

          и т.д.

но это в итоге получается громоздко.....

я пыталась сделать:

Код:

p=1              ' переменная р будет меняться впоследствии по IF или по CASE....
Set rs = CurrentDb.OpenRecordset("select * from ВыборкаТ where Месяц =p")

однако выдается ошибка....


В чем дело?

[RomCom]

Код:

Set rs = CurrentDb.OpenRecordset("select * from ВыборкаТ where Месяц =" & p)

[Алёна]

А теперь возникает ситуация, что в таблице нету переменной равной р

и поэтому выдается ошибка "текущая запись отсутствует"


 

Код:

  Set rs = CurrentDb.OpenRecordset("select * from ВыборкаТ where Месяц=" & p1)
     
            bl1 = rs.Fields(2).Value

Как мне в этой записи сделать проверку наличия поля rs.Fields(2).Value

т.е. сделать обработку ошибок


P.S. В данное время я сильно ограничена во времени, поэтому разбираться мне некогда, а делать надо, поэтому я и спрашиваю......

[RomCom]

Если необходима проверка на наилчие записей, придется действовать в два этапа:

Код:

Set rs = CurrentDb.OpenRecordset("select count(*) from ВыборкаТ where Месяц=" & p1)
If rs.Fields(0).Value > 0 Then
 rs.Close;
 Set rs = CurrentDb.OpenRecordset("select * from ВыборкаТ where Месяц=" & p1)
 ...
else
 rs.Close
End If

Или же проверять rs.RecordCount, но этот метод не дает 100% гарантии, т.к. если даже не найдено записей удовлетворяющих условию, то всеравно в rs будет одна запись только со значениями полей Null.

Количество полей в запросе можно узнать из rs.Fields.Count.

[HandKot]

а лучше проверять на конец рекордсета

Код:

Set rs = CurrentDb.OpenRecordset("select count(*) from ВыборкаТ where Месяц=" & p1)
If Not rs.eof then 
...
endif
rs.close

[Алёна]

Мерси за помощь.......

Я сдалась благополучно