-

   rss_sql_ru_access_programming

 - e-mail

 

 -

 LiveInternet.ru:
: 16.03.2006
:
:
: 4

:


" "

, 24 2019 . 22:55 +
, , ().
, " " VBA




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

, .

https://www.sql.ru/forum/1310595/oshibka-esli-forme-prisvoeno-znachenie-vsplyvaushhee-okno


: [1] []
 

:
: 

: ( )

:

  URL