Option Compare Database
Option Explicit
Private Sub Form_Current()
Dim strPicFile As String
Dim rs As Recordset
  Set rs = Me.RecordsetClone 'Для дальнейшей работы нужен набор записей
  If IsNull(Me!ID) Then 'Если запись новая, то очищаем картинку на форме
    Me.imgPicture.Picture = ""
  Else
    rs.Bookmark = Me.Bookmark 'Встаём на текущую запись формы
    strPicFile = GetPath(CurrentDb.Name) & "temp.jpg" & Me!PictureType 'Получаем координаты временного файла
    Call WriteBLOB(rs, "Picture", strPicFile) 'Пишем картинку из поля Picture во временный файл
    Me.imgPicture.Picture = strPicFile 'Выводим картинку из этого временного файла в форму
  End If
End Sub

Private Sub btnLoad_Click()
Dim strPicFile As String
Dim strFilter As String
Dim rs As Recordset
    'Зададим параметры и вызовем диалог открытия файла
    strFilter = ahtAddFilterItem(strFilter, "Картинки JPEG", "*.JPG")
    strPicFile = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
                    DialogTitle:="Выберите картинку...", _
                    flags:=ahtOFN_HIDEREADONLY)
    If strPicFile = "" Then Exit Sub 'Если файл не выбран - выходим из процедуры
    Me.txtPictureType = GetExt(strPicFile) 'Расширение файла картинки запомним в поле PictureType
     
                          ругается на строчку ниже, если ей ставлю " ' ", то тогда пишет что "данная запись используется другим пользователем, сохранение не возможно".
                             DoCmd.RunCommand acCmdSaveRecord 'Сохраним запись, что важно, если она новая
    


     Set rs = Me.RecordsetClone 'Для дальнейшей работы нужен набор записей
    rs.Bookmark = Me.Bookmark 'Встаём на текущую запись формы
    rs.Edit
      Call ReadBLOB(strPicFile, rs, "Picture") 'Пишем картинку из файла в поле Picture
    rs.Update
    'Пишем картинку обратно из поля Picture во временный файл в текущем каталоге базы
    Call WriteBLOB(rs, "Picture", GetPath(CurrentDb.Name) & "temp" & GetExt(strPicFile))
    'Выводим картинку из этого временного файла в форму
    Me.imgPicture.Picture = GetPath(CurrentDb.Name) & "temp" & GetExt(strPicFile)

End Sub

Private Sub Кн_Выход_Click()
On Error GoTo Err_Кн_Выход_Click
DoCmd.Close
    Dim stDocName As String
    Dim stLinkCriteria As String
    stDocName = "Данные"
    DoCmd.OpenForm stDocName, , , stLinkCriteria
Exit_Кн_Выход_Click:
    Exit Sub
Err_Кн_Выход_Click:
    MsgBox Err.Description
    Resume Exit_Кн_Выход_Click
End Sub

Private Sub btnLoad_Click()
Dim strPicFile As String
Dim strFilter As String
Dim rs As Recordset
    'Зададим параметры и вызовем диалог открытия файла
    strFilter = ahtAddFilterItem(strFilter, "Картинки JPEG", "*.JPG")
    strPicFile = ahtCommonFileOpenSave(Filter:=strFilter, OpenFile:=True, _
                    DialogTitle:="Выберите картинку...", _
                    flags:=ahtOFN_HIDEREADONLY)
    If strPicFile = "" Then Exit Sub 'Если файл не выбран - выходим из процедуры
    Me.txtPictureType = GetExt(strPicFile) 'Расширение файла картинки запомним в поле PictureType
 If Me.Dirty Then Me.Dirty = False
 '   DoCmd.RunCommand acCmdSaveRecord 'Сохраним запись, что важно, если она новая
    Set rs = Me.RecordsetClone 'Для дальнейшей работы нужен набор записей
    rs.Bookmark = Me.Bookmark 'Встаём на текущую запись формы
    rs.Edit
      Call ReadBLOB(strPicFile, rs, "Picture") 'Пишем картинку из файла в поле Picture
    rs.Update
    'Пишем картинку обратно из поля Picture во временный файл в текущем каталоге базы
    Call WriteBLOB(rs, "Picture", GetPath(CurrentDb.Name) & "temp" & GetExt(strPicFile))
    'Выводим картинку из этого временного файла в форму
    Me.imgPicture.Picture = GetPath(CurrentDb.Name) & "temp" & GetExt(strPicFile)

End Sub

Mid$(strPicFile, InStrRev(strPicFile, ".") + 1)