I have a from called frmMTTList that is a continuous form. AS the records are displayed on this form I have include and Edit button that display the Details on a from called frmMTTDetails. I am storing the location of an image on this screen. Now I found a sample database on this site that I have adapted. Code as follows:
Private Sub cmdAdd_Click()
' User asked to add a new photo
Dim strPath As String
' If you want to use the Office FileDialog object,
' comment out the following code and remove the
' comments from the block below
' ***** Begin ComDlg code
' Establish a new ComDlg object
With New ComDlg
' Don't allow multiple files
.AllowMultiSelect = False
' Set the title of the dialog
.DialogTitle = "Locate MTT picture File"
' Set the default directory
.Directory = CurrentProject.Path & "\Pictures\"
' .. and file extension
.Extension = "bmp"
' .. but show all graphics files just in case
.Filter = "Image Files (.bmp, .jpg, .gif, .pdf)|*.bmp;*.jpg;*.gif;*.pdf"
' Tell the common dialog that the file and path must exist
.ExistFlags = FileMustExist + PathMustExist
If .ShowOpen Then
strPath = .FileName
Else
Exit Sub
End If
End With
' ***** End ComDlg code
' Set an error trap
On Error Resume Next
' Set the image
Me.imgMTT.Picture = strPath
' Make sure that "took" OK
If Err = 0 Then
' Got a good file selection ...
' See if the photo is in a subpath of this project
If Left(strPath, Len(CurrentProject.Path)) = CurrentProject.Path Then
' Strip it off and store a relative path
strPath = Mid(strPath, Len(CurrentProject.Path) + 2)
End If
' Set the path in the record
Me.txtPhoto = strPath
' Hide the message
Me.lblMsg.Visible = False
' and reveal the new photo
Me.imgMTT.Visible = True
Else
' OOOps.
' Clear photo
Me.txtPhoto = Null
' Hide the frame
Me.imgMTT.Visible = False
' Clear the image
Me.imgMTT.Picture = ""
' Set the message
Me.lblMsg.Caption = "Failed to load the picture you selected. Click Add to try again."
' Make it visible
Me.lblMsg.Visible = True
End If
' Put focus in a safe place
Me.txtNoteDate.SetFocus
End Sub
Private Sub cmdDelete_Click()
' User asked to remove the picture
' Clear photo
Me.txtPhoto = Null
' Hide the frame
Me.imgMTT.Visible = False
' Clear the image
Me.imgMTT.Picture = ""
' Set the message
Me.lblMsg.Caption = "Click Add to create a photo for this MTT."
' Make it visible
Me.lblMsg.Visible = True
' Put focus in a safe place
Me.txtNoteDate.SetFocus
End Sub
Private Sub Form_Current()
' Load the current image, if any, when moving to new row
Dim strPath As String
' If on new record,
If Me.NewRecord Then
' Then set the message
Me.lblMsg.Caption = "Click Add to create a photo for this MTT."
' Make it visible
Me.lblMsg.Visible = True
' .. and hide the image frame
Me.imgMTT.Visible = False
Exit Sub
End If
' Try to load image - set error trap
On Error Resume Next
' If nothing in the photo text,
If IsNothing(Me.Photo) Then
' Then set the message
Me.lblMsg.Caption = "Click Add to create a photo for this MTT."
' Make it visible
Me.lblMsg.Visible = True
' .. and hide the image frame
Me.imgMTT.Visible = False
Else
strPath = Me.Photo
' Check for characters that indicate a full path
If (InStr(strPath, ":") = 0) And (InStr(strPath, "\\") = 0) Then
' Just a file name, so add the current path
strPath = CurrentProject.Path & "\" & strPath
End If
' Attempt to assign the file name
Me.imgMTT.Picture = strPath
' If got an error,
If Err <> 0 Then
' Then set the message
Me.lblMsg.Caption = "Photo not found. Click Add to correct."
' Make it visible
Me.lblMsg.Visible = True
' .. and hide the image frame
Me.imgMTT.Visible = False
Else
' Reveal the picture
Me.imgMTT.Visible = True
' And set the form palette so the picture displays correctly
Me.PaintPalette = Me.imgMTT.ObjectPalette
End If
End If
End Sub
Private Function SaveIt() As Integer
Dim lngErr As Long, strError As String
' Common Save routine called from cmdSave and a couple of other places
' Default: We expect this to work
SaveIt = True
' No need to do anything if the form isn't "dirty"
If (Me.Dirty = True) Then
' OK, gonna try to save - set error trap
On Error GoTo Save_Error
Me.Dirty = False ' Force a save by resetting Dirty
End If
Save_Exit:
Exit Function
Save_Error:
' Got here if the save failed. Handle most common errors
' (Some may be handled by Form_Error instead)
SaveIt = False ' Indicate save failed
' Try to analyze the error
Select Case Err
Case errCancel, errCancel2, errPropNotFound ' Cancel - ignore
Resume Save_Exit
Case errDuplicate ' Duplicate row - custom error message
MsgBox "You're trying to add a record that already exists. " & _
"Enter a new Note or click Cancel.", vbCritical, gstrAppTitle
Case errInvalid, errInputMask
' Invalid data - custom error and log
MsgBox "You have entered an invalid value. ", vbCritical, gstrAppTitle
ErrorLog Me.Name & "_Save", Err, Error
' Field validation, Table validation, Custom Validation, End of Search, Spelling Check
Case errValidation, errTableValidate, errCustomValidate, errSearchEnd, errSpellCheck
' Display the error
' All validation rules in the tables have custom error messages.
MsgBox Error, vbCritical, gstrAppTitle
Case Else
' Dunno - log and let error display
' Save the error code values because ErrorLog may get additional errors
lngErr = Err
strError = Error
ErrorLog Me.Name & "_Save", lngErr, strError
MsgBox "Error attempting to save: " & lngErr & " " & strError & Chr$(13) & Chr$(10) & "Try again or click Cancel to close without saving.", 48, gstrAppTitle
End Select
Resume Save_Exit
End Function
Now my issue It Adds the photo when I click the AddPhoto button but when I save and close the detail form and then once again in the List form I click the edit button and it is retaining everything but the image. I am not sure where I went bad....
Thank you,
Art Lorenzini
Sioux Falls, SF
Tidak ada komentar:
Posting Komentar