Public dbPP As DataBase. Открытие базы данных и создание набора записей с названиями организаций

Страницы работы

4 страницы (Word-файл)

Содержание работы

Public dbPP As DataBase

Public selectedCustomer As String

Public Sub SelectFromBase_Click()

'Эта процедура открывает базу данных Access "db1"

'Из таблицы "Заказчики" выбирается набор записей с названиями организаций

'и заполняется список в окне формы. Пользователь может выбрать нужную организацию

'и данные о ней будут перенесены в поля бланка "Заказ".

'MsgBox ("реакция на выбор кнопки Выбрать")

'Определить местоположение базы данных.

'Предполагается, что она находится в том же каталоге, что и приложение.

Dim strPathDb As String

Const NameDb = "db1"

strPathDb = LocateDb(NameDb)

'Открыть базу данных и создать набор записей с названиями организаций

Dim rstCustomer As Recordset

Dim qdfOrder As QueryDef

Set dbPP = OpenDatabase(strPathDb)

Set qdfOrder = dbPP.QueryDefs("Список заказчиков")

Set rstCustomer = qdfOrder.OpenRecordset

'Открыть форму со списком заказчиков

'Заполнить список заказчиков

Do While Not rstCustomer.EOF

'Добавить организацию в список

frmCustomers.lstCustomers.AddItem rstCustomer!Название

rstCustomer.MoveNext

Loop

frmCustomers.Show

End Sub

Private Function LocateDb(ByVal NameDb As String) As String

Dim strPath As String

strPath = Application.Workbooks(1).Path

LocateDb = strPath & "\" & NameDb

End Function

Public Sub SaveToBase_Click()

'Определить местоположение базы данных.

'Предполагается, что она находится в том же каталоге, что и приложение.

Dim strPathDb As String

Const NameDb = "db1"

strPathDb = LocateDb(NameDb)

'Открыть базу данных и создать набор записей с названиями организаций

Dim rstCustomer As Recordset

Set dbPP = OpenDatabase(strPathDb)

Set rstCustomer = dbPP.OpenRecordset("Заказчики")

'Добавление новой записи

With rstCustomer

.AddNew

.Bookmark = .LastModified

!Название = Range("data2")

!Адрес = Range("data3")

!Город = Range("data4")

!Телефон = Range("data5")

!Прочее = Range("data6")

.Update

End With

End Sub

Public Sub Books_Click()

'Эта процедура открывает базу данных Access "dbPP"

'Из таблицы "Книги" выбирается набор записей

'с названиями выпущенных редакцией книг и фамилиями их авторов.

'Пользователь может выбрать нужные ему книги

'и данные о них будут перенесены в таблицу бланка "Заказ".

'Определить местоположение базы данных.

'Предполагается, что она находится в том же каталоге, что и приложение.

Dim strPathDb As String

Dim intRow As Single

Dim MyArray() As String, MyArray1() As String

Const NameDb = "db1"

strPathDb = LocateDb(NameDb)

'Открыть базу данных и создать набор записей с названиями книг

Dim rstBook As Recordset

'Временный запрос

Dim qdfOrder As QueryDef

Set dbPP = OpenDatabase(strPathDb)

Set qdfOrder = dbPP.QueryDefs("Список книг")

Set rstBook = qdfOrder.OpenRecordset

'Открыть форму со списком книг

'Заполнить список книг

'ReDim MyArray(1, 0)

'MyArray(0, 0) = "Автор"

'MyArray(1, 0) = "Название"

intRow = 1

Do While Not rstBook.EOF

'Добавить книгу в список

ReDim Preserve MyArray(2, intRow)

MyArray(0, intRow - 1) = rstBook!Автор

MyArray(1, intRow - 1) = rstBook!Название

intRow = intRow + 1

rstBook.MoveNext

Loop

frmBooks.lstBooks.Column() = MyArray

frmBooks.Show

End Sub

В код формы

Private Sub ВыбериНас_Click()

Dim intLoop As Integer, intSelect As Integer

Dim ВыборСделан As Boolean

Dim KeyAuthor As String, KeyName As String

Dim strSelect As String

Dim strAdr As String, strAddress As String

Dim rstBookInfo As Recordset

Dim curField As Range

ВыборСделан = False

intLoop = 0

intSelect = 0

Do

If frmBooks.lstBooks.Selected(intLoop) Then

ВыборСделан = True

intSelect = intSelect + 1

strAdr = LTrim(Str(30 + intSelect))

KeyAuthor = frmBooks.lstBooks.Column(0, intLoop)

KeyName = frmBooks.lstBooks.Column(1, intLoop)

strSelect = "Select * FROM [Книги] WHERE [Название] =""" & KeyName & """"

Set rstBookInfo = dbPP.OpenRecordset(strSelect)

strAddress = "G" & strAdr

Set curField = Range(strAddress)

curField = rstBookInfo!Название

strAddress = "E" & strAdr

Set curField = Range(strAddress)

curField = rstBookInfo!Автор

strAddress = "K" & strAdr

Set curField = Range(strAddress)

curField = rstBookInfo![Единица измерения]

strAddress = "L" & strAdr

Set curField = Range(strAddress)

curField = rstBookInfo!Цена

strAddress = "D" & strAdr

Set curField = Range(strAddress)

curField = intSelect

End If

intLoop = intLoop + 1

Loop Until intLoop = frmBooks.lstBooks.ListCount

If ВыборСделан Then

Unload Me

Else

MsgBox ("Выберите книги")

End If

End Sub

В код формы

Private Sub ВыбериМеня_Click()

Dim intLoop As Integer

Dim ВыборСделан As Boolean

Dim Key As String, strSelect As String

Dim rstCustInfo As Recordset

Dim curField As Range

ВыборСделан = False

intLoop = 0

Do

If frmCustomers.lstCustomers.Selected(intLoop) Then

ВыборСделан = True

Exit Do

End If

intLoop = intLoop + 1

Loop Until intLoop = frmCustomers.lstCustomers.ListCount

If ВыборСделан Then

Key = frmCustomers.lstCustomers.List(intLoop)

strSelect = "Select * FROM [Заказчики] WHERE [Название] =""" & Key & """"

Set rstCustInfo = dbPP.OpenRecordset(strSelect)

'rstCustInfo.MoveFirst

'rstCustInfo.FindFirst "[Название]=Key"

'WHERE Заказчики!Организация = Key")

Set curField = Range("data2")

curField = rstCustInfo!Название

Set curField = Range("data3")

curField = rstCustInfo!Адрес

Set curField = Range("data4")

curField = rstCustInfo!Город

Set curField = Range("data5")

curField = rstCustInfo!Телефон

Set curField = Range("data6")

curField = rstCustInfo!Прочее

Unload Me

Else

MsgBox ("Выберите Заказчика")

End If

End Sub

Похожие материалы

Информация о работе

Предмет:
Информатика
Тип:
Дополнительные материалы
Размер файла:
38 Kb
Скачали:
0