У меня временная база пересоздается каждый раз при запуске программы. Функция копирует шаблоны временных таблиц из интерфейсной базы, имя которых подходит под условие: temp_*_def. Например, temp_import_def.

Текст функции:

Public Sub CM_CreateTempMDB()
' Скоков С.А. 2007-04-02
' Создание временной БД. Временные таблицы в текущей БД должны соответствовать формату temp_*_def.
' Подлинковываться в текущую БД они будут с именами temp_*
' внешние модули: mc_LT, mc_File, mc_StrSost
On Error GoTo Err_
    Dim db As DAO.Database
    Dim tdf As DAO.TableDef
    Dim pathToDb As String

    Call mc_StrSost.CM_StrSost("Создание временного файла")

    '-- создание БД
    pathToDb = mc_File.CM_GetDBPath & "temp.mdb"

    If Dir(pathToDb) <> "" Then
        Call Kill(pathToDb)
    End If

    Set db = CreateDatabase(pathToDb, dbLangGeneral)
    db.Close

    '-- копирование таблиц во временную БД
    Set db = CurrentDb

    For Each tdf In db.TableDefs
        If tdf.Name Like "temp_*_def" Then
            DoCmd.CopyObject pathToDb, Left(tdf.Name, Len(tdf.Name) - 4), acTable, tdf.Name
        End If
    Next

    '-- линковка временных таблиц
    mc_LT.CM_LT_AddAllExt (pathToDb)
Exit_:
    Call mc_StrSost.CM_StrSost
    Exit Sub
Err_:
    Err.Raise Err.Number, "CM_CreateTempMDB()->" & Err.Source, Err.Description
    Resume Exit_
End Sub

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

Их всего три:

• CM_LT_AddAllExt() — добавляет в текущую базу ссылки на таблицы из mdb файла
• CM_LT_AddAllExt_ODBC() — добавляет в текущую базу ссылки на ODBC таблицы на сервере
• CM_LT_DelAll() — удаляет таблицы-ссылки из текущей базы

Они позволяют создать в интерфейсной базе ссылки на таблицы из базы с данным. У меня они запускаются каждый раз при запуске. Написаны они давным давно, но полезны до сих пор.

Текст функций:

Public Function CM_LT_AddAllExt(ByVal stPathToBase As String) As Long
' <Скоков С.А.> создана: 2004-02-05
' подлинковывает все таблицы из указанной базы
' проверяет существует ли подлинковываемая таблица в текущей как ссылка, то обновляется строка подключения.
' если же в тек. базе есть таблица с таким именем (не ссылка), то подлинковываемая таблица пропускается
' т.о. перед вызовом этой функции удалять линкованные таблицы не нужно
' вход: stPathToBase - путь и имя базы
' выход: количество не подлинкованных таблиц, в случае ошибки возвращает -1

On Error GoTo Err_
    CM_LT_AddAllExt = 0

    Dim tdf As TableDef
    Dim db As Database
    Dim bIsSysOrLink As Boolean
    Dim stNameTbl As String
    Dim lCountNotLinket As Long ' количество не подлинкованных таблиц
    Dim stConnect As String
    Dim dbCur As DAO.Database
    Dim tdfNew As DAO.TableDef
    Dim tdfsCur As DAO.TableDefs

    stConnect = ";DATABASE=" & stPathToBase
    Set dbCur = CurrentDb
    Set tdfsCur = dbCur.TableDefs

    '-- делаем масив таблиц в текущей базе
    Dim masNameTbl() As String
    Dim i As Long

    tdfsCur.Refresh
    ReDim masNameTbl(tdfsCur.count - 1)
    i = 0
    For Each tdf In tdfsCur
        masNameTbl(i) = tdf.Name
        i = i + 1
    Next tdf

    '-- коннектимся к базе
    Set db = OpenDatabase(stPathToBase)

    lCountNotLinket = 0
    '-- линкуем
    For Each tdf In db.TableDefs
        bIsSysOrLink = (tdf.Attributes And dbSystemObject) Or _
                    (tdf.Attributes And dbHiddenObject) _
                    Or (tdf.Attributes And dbAttachedTable) ' системная или присеоединенная ли?

        If Not bIsSysOrLink Then  ' если не то что выше, то можно делать линк
            stNameTbl = tdf.Name
            '-- если такая таблица существует в текущей базе
            If SerchStrInMas(masNameTbl, stNameTbl) <> -1 Then
                '-- то проверяем подлинкованая ли? иначе пропускаем эту таблицу и переходим на следующую
                If (tdfsCur(stNameTbl).Attributes And dbAttachedTable) Then
                    '-- обновляем путь к бд
                    tdfsCur(stNameTbl).Connect = stConnect
                    tdfsCur(stNameTbl).RefreshLink
                Else
                    Debug.Print "CM_LT_AddAllExt(), пропущена таблица:", stNameTbl
                    lCountNotLinket = lCountNotLinket + 1
                End If
            Else
				'-- не существует - то линкуем
                Set tdfNew = dbCur.CreateTableDef(stNameTbl)
                tdfNew.SourceTableName = stNameTbl
                tdfNew.Connect = stConnect
                tdfsCur.Append tdfNew
            End If
        End If
    Next tdf

    db.Close
    Set db = Nothing

    tdfsCur.Refresh
    Set tdfsCur = Nothing
    Set dbCur = Nothing

    CM_LT_AddAllExt = lCountNotLinket
Exit_:
    Exit Function

Err_:
    CM_LT_AddAllExt = -1
	Err.Raise Err.Number, "CM_LT_AddAllExt()->" & Err.Source, Err.Description '-- передаем ошибку в вызвавшую функцию

    Resume Exit_
End Function

Private Function SerchStrInMas(ByRef masStr() As String, ByRef SerchStr As String) As Long
' <Скоков С.А.> создана: 2004-02-05

' Поиск строки в строковом массиве
' вход: masStr - массив строк
'       SerchStr - искомая строка
' выход:
'   номер элемента массива, в котором была найдена подстрока SerchStr, иначе -1 (когда нет совпадений)
'   при ошибке возвращает -1

On Error GoTo Err_

    Dim i As Long

    SerchStrInMas = -1

    For i = LBound(masStr) To UBound(masStr)
        If masStr(i) = SerchStr Then
            SerchStrInMas = i
            Exit For
        End If
    Next i

Exit_:
    Exit Function
Err_:
    SerchStrInMas = -1
    Resume Exit_
End Function

Public Function CM_LT_AddAllExt_ODBC(ByVal stConnectStr As String) As Long
' <Кулага С.Ю.> создана: 2006-10-12

'   подлинковывает все таблицы из указанной базы
'   проверяет существует ли подлинковываемая таблица в текущей как ссылка, то удаляет.
'   если же это является таблицей, то подлинковываемая таблица пропускается
'   т.е. перед вызовом этой функции удалять линкованные таблицы не нужно, он удалить необходимые сама
' вход: stConnectStr - строка подключения ADO
' выход: количество не подлинкованных таблиц, в случае ошибки возвращает -1

On Error GoTo Err_
    CM_LT_AddAllExt_ODBC = 0

    Dim bIsSysOrLink As Boolean
    Dim stNameTbl As String
    Dim tdf As TableDef
    Dim lCountNotLinket As Long ' количество не подлинкованных таблиц
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim stConnectTbl As String
    Dim dbCur As DAO.Database
    Dim tdfNew As DAO.TableDef
    Dim tdfsCur As DAO.TableDefs

    stConnectTbl = "ODBC;" & stConnectStr
    Set dbCur = CurrentDb
    Set tdfsCur = dbCur.TableDefs

    ' делаем масив таблиц в текущей базе
    Dim masNameTbl() As String
    Dim i As Long

    ReDim masNameTbl(tdfsCur.count - 1)
    i = 0
    For Each tdf In tdfsCur
        masNameTbl(i) = tdf.Name
        i = i + 1
    Next tdf

    ' коннектимся к базе
    Set cnn = New ADODB.Connection
    cnn.Open (stConnectStr)
    Set rst = cnn.OpenSchema(adSchemaTables)

    lCountNotLinket = 0
    ' линкуем
    Do While Not rst.EOF
        stNameTbl = rst("TABLE_NAME")
        ' если такая таблица существует в текущей базе
        If SerchStrInMas(masNameTbl, stNameTbl) <> -1 Then
            ' то проверяем линкованая ли? иначе пропусаем эту таблицу и переходим на следующую
            If (tdfsCur(stNameTbl).Attributes And (dbAttachedTable + dbAttachedODBC)) Then
                '-- обновляем путь к бд
                tdfsCur(stNameTbl).Connect = stConnectTbl
                tdfsCur(stNameTbl).RefreshLink
            Else
                Debug.Print "CM_LT_AddAllExt_ODBC(), пропущена таблица:", stNameTbl
                lCountNotLinket = lCountNotLinket + 1
            End If
        Else
			'-- не существует - то линкуем
            Set tdfNew = dbCur.CreateTableDef(stNameTbl)
            tdfNew.SourceTableName = stNameTbl
            tdfNew.Connect = stConnectTbl
            tdfsCur.Append tdfNew
        End If
        rst.MoveNext
    Loop

    tdfsCur.Refresh
    Set tdfsCur = Nothing
    Set dbCur = Nothing

    rst.Close
    cnn.Close
    CM_LT_AddAllExt_ODBC = lCountNotLinket

Exit_:
    Exit Function

Err_:
    Err.Raise Err.Number, "CM_LT_AddAllExt_ODBC()->" & Err.Source, Err.Description '-- передаем ошибку в вызвавшую функцию
    CM_LT_AddAllExt_ODBC = -1
    Resume Exit_
End Function

Public Function CM_LT_DelAll() As Boolean
' <Скоков С.А.> создана: 2003-12-12

' удаляет все связаные таблицы в текущей базе

On Error GoTo Err_

    Dim tdf As TableDef
    Dim db As Database
    Dim bIsAttached As Boolean

    Set db = CurrentDb

    For Each tdf In db.TableDefs
        bIsAttached = (tdf.Attributes And dbAttachedODBC) _
                Or (tdf.Attributes And dbAttachedTable) ' присеоединенная таблица обыкновенная или ODBC

        If bIsAttached Then ' удаляем только прилинкованные
            DoCmd.DeleteObject acTable, tdf.Name
        End If
    Next

    Set db = Nothing
    CM_LT_DelAll = True
Exit_:
    Exit Function
Err_:
    CM_LT_DelAll = False

	Err.Raise Err.Number, "CM_LT_DelAll()->" & Err.Source, Err.Description '-- передаем ошибку в вызвавшую функцию
    Resume Exit_
End Function

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

• CM_LogMsg() — записать сообщение
• CM_LogErrForm() — записать сообщение об ошибке в форме
• CM_LogErr() — записать сообщение об ошибке
• CM_LogCheckSize() — проверяет размер файла лога. Обычно используется только при запуске приложения.
• CM_LogGetPathFile() — формирует путь к файлу лога
• CM_LogErrDAO() — записать ошибки, возникшие при работе с данными. Только при использовании библиотеки DAO.

«Живут» эти функции в модуле: mc_Log.

Текст функций:

' функции для ведения лога в текстовый файл

'-- имя файла лога
Private Const c_imFileLog As String = "Log.txt"

Public Sub CM_LogMsg(ByRef stMsg As String)
' <Скоков С.А.> 2005-04-05

' запись в файл сообщения
' вход:
'       stMsg - строка сообщения

On Error Resume Next '-- нет обработки ошибок

    Dim iNomFile As Integer

    '-- получаем свободный номер файла
    iNomFile = FreeFile

    Open CM_LogGetPathFile() For Append As #iNomFile
    Print #iNomFile, "m"; Spc(1); Date; Spc(1); Time; Spc(1); stMsg
    Close #iNomFile
End Sub

Public Sub CM_LogErrForm(ByRef frm As Form _
                , ByVal imFunc As String _
                , Optional ErrNom As Variant _
                , Optional ErrDescription As Variant)
' <Скоков С.А.> 2010-03-28

    If frm Is Nothing Then
        imFunc = "Nothing::" & imFunc
    Else
        imFunc = frm.Name & "::" & imFunc
    End If

    Call CM_LogErr(imFunc, ErrNom, ErrDescription)
End Sub

Public Sub CM_LogErr(ByRef imFunc As String _
                , Optional ErrNom As Variant _
                , Optional ErrDescription As Variant)
' <Скоков С.А.> 2005-04-05

' запись в файл сообщения об ошибке
' вход:
'       imFunc - имя функции
'       ErrNom - номер ошибки. если пропущено, то данные берутся из Err.Nuber
'       ErrDescription - строка сообщения/описания ошибки
'                        если пропущено, то данные берутся из Err.Description

    Dim iNomFile As Integer

    '-- обработка входных параметров
    If IsMissing(ErrNom) Then
        ErrNom = Err.Number
    End If

    If IsMissing(ErrDescription) Then
        ErrDescription = Err.Description
    End If

On Error Resume Next '-- нет обработки ошибок

    '-- получаем свободный номер файла
    iNomFile = FreeFile

    Open CM_LogGetPathFile() For Append As #iNomFile
    Print #iNomFile, "e"; Spc(1); Date; Spc(1); Time; Spc(1); _
                    imFunc; Spc(1); "Err: "; ErrNom; Spc(1); ErrDescription
    Close #iNomFile
End Sub

Public Sub CM_LogCheckSize(Optional ByVal lLenMax As Double = 1048576)
' Скоков С.А. 2006-12-07
' проверяет размер файла лога и удаляет если он превышает лимит
' lLenMax - максимальная длинна файла, по умолчанию 1 Мб
    Dim oFSO As Object, oFile As Object
    Dim stPathFile As String

    stPathFile = CM_LogGetPathFile()

    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFile = oFSO.GetFile(stPathFile)

    If oFile.Size >= lLenMax Then
        Kill stPathFile
    End If
End Sub

Public Function CM_LogGetPathFile() As String
' Скоков С.А. 2006-12-07
' возвращает путь с именем файла лога
    Dim Db As DAO.Database

    Set Db = CurrentDb
    CM_LogGetPathFile = Left(Db.Name, Len(Db.Name) - Len(Dir(Db.Name))) + c_imFileLog
End Function

Public Sub CM_LogErrDAO(ByRef imFunc As String, Optional ByRef errs As DAO.Errors = Nothing)
' <Скоков С.А.> 2006-12-07

' запись в файл сообщения об ошибке
' вход:
'       imFunc - имя функции
'       ErrNom - номер ошибки. если пропущено, то данные берутся из Err.Nuber
'       ErrDescription - строка сообщения/описания ошибки
'                        если пропущено, то данные берутся из Err.Description
'

On Error Resume Next '-- нет обработки ошибок
    Dim iNomFile As Integer
    Dim errTek As DAO.Error
    '-- получаем свободный номер файла
    iNomFile = FreeFile

    If errs Is Nothing Then
        Set errs = DAO.Errors
    End If

    Open mc_Log.CM_LogGetPathFile() For Append As #iNomFile
    For Each errTek In errs
        Print #iNomFile, "e"; Spc(1); Date; Spc(1); Time; Spc(1); _
                        imFunc; Spc(1); errTek.Source; " Err: "; errTek.Number; Spc(1); errTek.Description
    Next errTek
    Close #iNomFile
End Sub

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

• CM_RecsInStr()
• CM_RecsInStrExt()

Отличия между ними заключаются в параметрах. CM_RecsInStr() работает с Recordset, а CM_RecsInStrExt() с запросом или именем таблицы.

Эти функции я часто использую, что бы показать информацию о сложном объекте в сжатом виде. Например, для заказа можно показать выбранные товары через запятую, при этом можно ограничить вывод первыми 10 записями.

Пример использования:

Dim lK_OREDER As Long
Dim rst As DAO.Recordset
Dim stSQL As String

lK_OREDER = 123
stSQL = "SELECT TOP 25 T_ORDER_ITEM & '(' & N_COUNT & ')' As T_ITEM FROM K_ORDER = " & lK_OREDER

Set rst = CurrentDb.OpenRecordset(stSQL, dbOpenForwardOnly)

MsgBox CM_RecsInStr(rst, "T_ITEM", " | ")
MsgBox CM_RecsInStr(stSQL , "T_ITEM", " | ")

В результате работы примера получим примерно такую строку:

Товар А (1) | Товар Б (2) | Товар В (1)


Наиболее удачной получилось CM_RecsInStrExt(). Иногда для простоты я ее использую в качестве истоника данных полей на формах.

Текст функций:

Public Function CM_RecsInStr(ByRef rstTable As Recordset _
                            , ByVal stFieldName As String _
                            , Optional ByVal SimvRazd As String = ",") As String
' Скоков С.А.
' Формирует строку из записей таблицы, разделяя их запятыми
' rstTable - ссылка на открытый набор записей
' stFieldName - имя поле, из которого брать данные
' SimvRazd - символ разделитель значений

On Error GoTo Err_

    Dim stRet As String

    ' если есть записи то
    If rstTable.RecordCount > 0 Then
        ' это потому что эти значения разделяются запятыми и ставятся перед присваиванием
        '    знач. из таблицы см. цикл ниже
        '    а перед первым значением запятую ставить не нужно
        stRet = Nz(rstTable(stFieldName))
        rstTable.MoveNext
    End If

    Do While Not rstTable.EOF
        stRet = stRet & SimvRazd & Nz(rstTable(stFieldName))
        rstTable.MoveNext
    Loop

    CM_RecsInStr = stRet

Exit_:
    Exit Function

Err_:
    Err.Raise Err.Number, "CM_RecsInStr() ->" & Err.Description, Err.Description
    Resume Exit_
    Resume
End Function

Public Function CM_RecsInStrExt(ByVal stSQL As String _
                                , ByVal stFieldName As String _
                                , Optional ByVal SimvRazd As String = ", ") As String
' Скоков С.А.
' Формирует строку из записей таблицы, разделяя их разделителями (запятыми)
' stSQL - запрос (может быть и именем таблицы или сохраненного запроса)
' stFieldName - имя поле, из которого брать данные
' SimvRazd - символ разделитель значений
On Error GoTo Err_

    Dim stRet As String
    Dim rstTable As Recordset

    Set rstTable = CurrentDb.OpenRecordset(stSQL, dbOpenDynaset)
    ' если есть записи то
    If rstTable.RecordCount > 0 Then
        ' это потому что эти значения разделяются запятыми и ставятся перед присваиванием
        '    знач-я из таблицы (см. цикл ниже),
        '    а перед первым значением запятую ставить не нужно
        stRet = Nz(rstTable(stFieldName))
        rstTable.MoveNext
    End If

    Do While Not rstTable.EOF
        stRet = stRet & SimvRazd & Nz(rstTable(stFieldName))
        rstTable.MoveNext
    Loop

    rstTable.Close

    CM_RecsInStrExt = stRet

Exit_:
    Exit Function

Err_:
    Err.Raise Err.Number, "CM_RecsInStrExt() ->" & Err.Description, Err.Description
    Resume Exit_
End Function

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

MS Access 2003 поддерживает событие MouseWheel, но, увы, не позволяет отменить это. Даже DoCmd.CancelEvent не помогает.

Private Sub Form_MouseWheel(ByVal Page As Boolean, ByVal Count As Long)
    DoCmd.CancelEvent '-- не работает
End Sub

Одно из решений это хук событий формы описанный на сайте microsoft (How to Detect and Prevent the Mouse Wheel from Scrolling Through Records in a Form). И тут не обошлось без недостатков. Если не использовать внешней dll, то периодически форма тормозит, т.к. все события проваливаются через медленный VBA. Возможно, если вынести данный код в dll, то будет работать на порядок быстрее. Мне не захотелось возится с отдельной dll, т.к. я нашел метод попроще (об этом ниже). Пока я исследовал пример, немного расширил его. Результат трудов можно скачать тут, вдруг кому понадобится.

Более простым решением на мой взгляд является фильтр по ключевому полю. При этом нужно отключить добавление записей. У этой идеи тоже есть недостатки:

• для ленточных форм, естественно, это не работает.
• нужно реализовывать добавление записи, а потом уже открывать ее на редактирование.

Какой вариант выбрать зависит от ситуации. Я же стараюсь свести дизайн программы ко второму варианту. Уж больно он мне по душе.

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

Недавно на моем любимом форуме проскакивал одноименный ответ. Сперва я сам как-то задумался, а как же. Но как оказалось задача «По номерам недель получить временной промежуток для фильтра по датам» оказалось проще простого. Для этого я воспользовался любимым методом «Разделяй и властвуй».

И так, задача разбилась на три части:
1. Функция, которая вернет дату начала недели по номеру недели и году.

Public Function GetDateOfStartWeek(ByVal nWeek As Byte, ByVal nYear As Integer) As Date

    Dim dt1Jan As Date
    Dim dayFirstWeek As Integer
    Dim dtResult As Date

    dt1Jan = DateSerial(nYear, 1, 1)
    dayFirstWeek = Weekday(dt1Jan, vbMonday)
    dtResult = DateAdd("ww", nWeek - 1, dt1Jan)

    If dayFirstWeek > 1 And nWeek > 1 Then
      dtResult = DateAdd("d", -1 * (7 - Weekday(dt1Jan, vbMonday) + 2), dtResult)
    End If

    GetDateOfStartWeek = dtResult
End Function

2. Функция, которая вернет дату окончания недели по номеру недели и году.

Public Function GetDateOfEndWeek(ByVal nWeek As Byte, ByVal nYear As Integer) As Date
    GetDateOfEndWeek = DateAdd("d", 7 - 1, GetDateOfStartWeek(nWeek, nYear))
End Function

3. Фнункция, которая вернет условие за период по датам:

public frunction GetWherePeriod(ByVal imFld as string, ByVal dtFrom as Date, ByVal dtTo as Date) as String
   GetWherePeriod = BuildCriteria(imFld, dbDate, "Between " & dtFrom & " And " & dtTo & "")
End Public

'-- Проверка
Debug.Print GetWherePeriod(GetDateOfStartWeek(1, 2010), GetDateOfEndWeek(1, 2010))

Как-то уж очень просто получилось… Функцию GetDateOfStartWeek() я активно не тестировал, проверял только для января за 2010 и 2007 года. Если будут ошибки, пишите.

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья. ]]> http://5codelines.net/kvartal-v-datu/feed/ 0 http://5codelines.net/kak-poluchit-znachenie-polya-tablicy/?utm_source=rss&utm_medium=rss&utm_campaign=kak-poluchit-znachenie-polya-tablicy http://5codelines.net/kak-poluchit-znachenie-polya-tablicy/#comments Mon, 12 Oct 2009 14:23:29 +0000 Сергей Скоков http://5codelines.net/?p=172

Очень часто новички сталкиваются с задачей прочитать значение из поля таблицы. Например, они знают о существовании библиотек DAO или ADO и пишут свою функцию для вычисления этой операции (или не пишут, а идут на форумы спрашивать ). Но ведь есть встроенные. Знакомьтесь:

• DLookUp
• DFirst
• DLast
• DCount
• DMax
• DMin

У всех этих функций одинаковые параметры: имя поля или выражение, таблица, условие отбора. Возвращать они могут Null (кроме DCount), по этому использование nz() не будет лишним.

И напоследок пара примеров использования:

Public Sub test()
    Dim stKlient As String
    Dim lK_KLIENT As Long
    Dim count As Long

    lK_KLIENT = 123

    stKlient = Nz(DLookup("T_KLIENT", "b_klient", "K_KLIENT = " & lK_KLIENT))
    count = DCount("*", "b_klient", "T_KLIENT LIke '" & Left(stKlient, 3) & "*'")
End Sub

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

Как оказалось очень полезно смотреть ключевые слова, по которым пользователи переходят на мой сайт. В них можно найти новые тему. Например, как эту. Оказывается, у некоторых это вызывает трудности.

Как создать меню
В прошлой статье про меню я забыл дорасказать, как же все же добавляеть новые пункты меню в строку меню. По-этом рекомендую сперва ознакомится с прошлым постом и пеерходить к чтению этого.

Как создать пункты меню

Чтобы сюда попасть можно выбрать пункт меню MS Access «Сервис — Настройка» или кликнуть в пустом месте меню и в контестном меню выбрать пункт «Настройка».

Теперь все внимание на вкладку «Команды» нового окошка.

В категории «Файл» вы найдете пункт меню «Специальная». Это рабочая лошадка меню. На самом деле это кнопка.

В категории «Новое меню» найдете выпадающее меню «Новое меню». На самом деле это поле с выпадающим списком.

Еще в категории «Все формы» и т.п. вы найдете соостветственно готовые пункты меню. У них есть свои особенности. Об этом ниже.

Это все «многообразие» элементов можно при помощи перетаскивания перенести на свою строку меню или панель инструментов (я надеюсь вы прочитали предыдущую статью и знаете как это делать).

Как выполнить действие
Тут самое интересное. Только не закрывайте чудесное окошко «Настройка». Кликните правой кнопочкой мыши на любом пункте меню (не список!) и в контекстном меню выберете пункт «Свойства». У вас откроется следующее окошко:

Все поля содержат описание и понятны. При помощи этого пункта меню можно вызвать любую функцию из модуля, написав так =MyFunction(). Чаще всего я использую именно этот способ, т.к. частенько формы открываются с какими-то параметрами.

Особенности открытия форм
А теперь давайте таким же образом откроем пункт меню, созданный перетаскиванием пункта из группы «Все формы», например.

В свойстве «Параметр» вы обнаружите имя формы. Так вот, если прописать это же имя в пункте меню из группы «File», то форма не откроется. Вот такой чудесный нюанс.

В следующий раз опишу о программном создании и управлении меню.

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

Поэтому пришлось написать свою функцию. Благодаря тому, что функция принимает ссылку на форму, а не имя, то можно ее использовать для любой формы, подчиненной, созданной при помощи DoCmd.OpenForm или оператора New.

Public Sub CM_FormGoToLastRecord(Optional ByRef frm As Form = Nothing)
' перейти на последнюю запись
' frm можно не передавать, в этом случае она будет получена при помощи CodeContextObject
On Error GoTo Err_

    If frm Is Nothing Then
        Set frm = CodeContextObject
    End If

    If frm Is Nothing Then Exit Sub

    Dim rst As DAO.Recordset

    Set rst = frm.RecordsetClone
    If Not rst.EOF Then rst.MoveLast
    frm.Bookmark = rst.Bookmark

Exit_:
    Exit Sub
Err_:
    mc_Log.MC_LogErr ("CM_FormGoToLastRecord()")
    Resume Exit_:
End Sub

mc_Log.MC_LogErr ("FormGoToLastRecord()") - фукнция, которая логирует ошибку в текстовом файле. О ведении лога я как-нибудь расскажу попозже.

CodeContextObject
В процедуре CM_FormGoToLastRecord() используется такая штука, как CodeContextObject, которое в справке называют свойством. Это свойство позволяет получить ссылку на объект, в рамках которого выполняется данный код. Если вызвать процедуру CM_FormGoToLastRecord() в событии подчиненной формы, то CodeContextObject выдаст ссылку на подчиненную форму. Этот же способ использует DoCmd.GoToRecord, когда не указывается имя объекта.

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.

Рассмотрим эту задачку на примере диаграмм.
На форму (или отчет) вставим диаграмму с именем “OLE_PRODAZHA_CHART” и изменим название диаграммы программно.
Далее необходимо подключить библиотеку “Microsoft Graph X.0 Object Library”, чтобы тип “Chart” (диаграмма) стал доступен (ниже узнаете зачем он нужен). Увы для диаграмм Access почему-то не добавляет ссылку на библиотеку.
Также добавим на форму кнопку с названием “Изменить название диаграммы”. В обработчике событий разместим следующий код:

Dim obj As Graph.Chart

Set obj = Me.OLE_PRODAZHA_CHART.Object
obj.ChartTitle.Text = "Мое название"

Весь фокус заключается в типе “Graph.Chart” и свойстве “Object” элемента управления. Свойство “Object” элемента управления возвращает ссылку на созданный объект. Библиотека “Microsoft Graph X.0 Object Library” в коде называется Graph и предоставляет класс типа Chart. Теперь можно пользоваться справкой и просмотреть все свойства и методы класса Graph.Chart.

Как быть с другим ActiveX объектами?
После вставки ActiveX элемента на форму, Access сам добавить Reference на библиотеку типов. Найти библиотеку и тип ActiveX элемента можно найти в Object Browser (в редакторе кода можно нажать кнопку F2).
Чтобы точно определить имя нужной библиотеки и типа ActiveX элемента, давайте посмотрим на свойства уже ранее созданной диаграммы. А именно “Класс” и “Класс OLE”.
Для диаграммы свойства имеют значения:
- Класс = MSGraph.Chart.8
- Класс OLE = Microsoft Graph Chart
“Класс OLE” содержит описание для пользователя. По этому имени можно найти библиотеку типов списке ссылок (Tools->References). “Класс” содежит имя класса, при помощи которого можно создать этот объект.

Возвращаясь к злосчастной диаграмме, в Object Browser имя библиотеки будет Graph, а имя класса Chart.

В примере вы также найдете ActiveX элемент TreeView, посмотрите код в модуле формы. Там добавлена обработка события, которого нет в списке событий в свойствах элемента управления.

До встречи!

(с) Скоков Сергей

Подписаться на: RSS или e-mail рассылку или добавить в ЖЖ друзья.