I
Incolor
I have a form where images are added. An image will not always be
added. Right now if you ad an image to a record on the form and go to
the next instead of the image control being blank it show the last
image, but it is not saved in the underlying table. It just shows it
on the image control. How do I clear the image path to the control so
that the next record has not image? I am fairly new to VBA (coding)
and not sure how to do this in code.
Option Compare Database
Option Explicit
Dim path As String
Private Sub AddPicture_Click()
getFileName
End Sub
Private Sub Form_AfterUpdate()
Me!MATERIAL_CODE.Requery
On Error Resume Next
ShowErrorMessage
showImageFrame
If (IsRelative(Me!ImagePath) = True) Then
Me![ImageFrame].Picture = path & Me![ImagePath]
Else
Me![ImageFrame].Picture = Me![ImagePath]
End If
End Sub
Private Sub Form_RecordExit(Cancel As Integer)
'Hide the errormsg label to reduce flashing when navigating
'between records.
errormsg.Visible = False
End Sub
Private Sub RemovePicture_Click()
'Clear the file name for the record and display the
'errormsg label.
Me![ImagePath] = ""
hideImageFrame
errormsg.Visible = True
End Sub
Private Sub Form_Current()
'Display the picture for the current record if the image exists.
'If the file name no longer exists or the file name was blank for
the
'current record, set the errormsg label caption to the appropriate
message.
Dim res As Boolean
Dim fname As String
On Error GoTo ErrorHandler
path = CurrentProject.path
' On Error Resume Next
errormsg.Visible = False
If Not IsNull(Me!PHOTO) Then
res = IsRelative(Me!PHOTO)
fname = Me![ImagePath]
If (res = True) Then
fname = path & "\" & fname
End If
Me![ImageFrame].Picture = fname
showImageFrame
Me.Repaint
'-------------------------------------------------------I ALSO ADDED
THIS TO FORCE A REDRAW OF THE FORM>>>
Else
End If
exit_here:
Exit Sub
ErrorHandler:
Select Case Err
Case 2220
'can't open picture...
hideImageFrame
errormsg.Caption = "Click Add/Change to add picture"
errormsg.Visible = True
Case Else
MsgBox "Error #" & Err.Number & ": " & Err.Description & " by "
& Err.Source & " at line " & Erl(), vbOKOnly, "Error in procedure
Form_current"
Resume exit_here
End Select
End Sub
Sub getFileName()
'Displays the office file open dialog to choose a file
'name for the current record. If the user selects a file
'display it in the image control.
Dim fileName As String
Dim result As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select Picture"
.Filters.Add "All Files", "*.*"
.Filters.Add "JPEGs", "*.jpg"
.Filters.Add "Bitmaps", "*.bmp"
.FilterIndex = 3
.AllowMultiSelect = False
.InitialFileName = CurrentProject.path
result = .Show
If (result <> 0) Then
fileName = Trim(.SelectedItems.Item(1))
Me![ImagePath].Visible = True
Me![ImagePath].SetFocus
Me![ImagePath].Text = fileName
Me![MATERIAL_CODE].SetFocus
Me![ImagePath].Visible = False
End If
End With
End Sub
Sub ShowErrorMessage()
'Display the errormsg label if the image file is not available.
If Not IsNull(Me!PHOTO) Then
errormsg.Visible = False
Else
errormsg.Visible = True
End If
End Sub
Function IsRelative(fname As String) As Boolean
'Return false if the file name contains a drive or UNC path
IsRelative = (InStr(1, fname, ":") = 0) And (InStr(1, fname, "\\")
= 0)
End Function
Sub hideImageFrame()
'Hide the image control
Me![ImageFrame].Visible = False
End Sub
Sub showImageFrame()
'Display the image control
Me![ImagePath].Visible = True
End Sub
Private Sub ImagePath_AfterUpdate()
'After selecting an image , display it.
On Error Resume Next
ShowErrorMessage
showImageFrame
If (IsRelative(Me!ImagePath) = True) Then
Me![ImageFrame].Picture = path & Me![ImagePath]
Else
Me![ImageFrame].Picture = Me![ImagePath]
End If
End Sub
Thanks in advance for your time!
added. Right now if you ad an image to a record on the form and go to
the next instead of the image control being blank it show the last
image, but it is not saved in the underlying table. It just shows it
on the image control. How do I clear the image path to the control so
that the next record has not image? I am fairly new to VBA (coding)
and not sure how to do this in code.
Option Compare Database
Option Explicit
Dim path As String
Private Sub AddPicture_Click()
getFileName
End Sub
Private Sub Form_AfterUpdate()
Me!MATERIAL_CODE.Requery
On Error Resume Next
ShowErrorMessage
showImageFrame
If (IsRelative(Me!ImagePath) = True) Then
Me![ImageFrame].Picture = path & Me![ImagePath]
Else
Me![ImageFrame].Picture = Me![ImagePath]
End If
End Sub
Private Sub Form_RecordExit(Cancel As Integer)
'Hide the errormsg label to reduce flashing when navigating
'between records.
errormsg.Visible = False
End Sub
Private Sub RemovePicture_Click()
'Clear the file name for the record and display the
'errormsg label.
Me![ImagePath] = ""
hideImageFrame
errormsg.Visible = True
End Sub
Private Sub Form_Current()
'Display the picture for the current record if the image exists.
'If the file name no longer exists or the file name was blank for
the
'current record, set the errormsg label caption to the appropriate
message.
Dim res As Boolean
Dim fname As String
On Error GoTo ErrorHandler
path = CurrentProject.path
' On Error Resume Next
errormsg.Visible = False
If Not IsNull(Me!PHOTO) Then
res = IsRelative(Me!PHOTO)
fname = Me![ImagePath]
If (res = True) Then
fname = path & "\" & fname
End If
Me![ImageFrame].Picture = fname
showImageFrame
Me.Repaint
'-------------------------------------------------------I ALSO ADDED
THIS TO FORCE A REDRAW OF THE FORM>>>
Else
End If
exit_here:
Exit Sub
ErrorHandler:
Select Case Err
Case 2220
'can't open picture...
hideImageFrame
errormsg.Caption = "Click Add/Change to add picture"
errormsg.Visible = True
Case Else
MsgBox "Error #" & Err.Number & ": " & Err.Description & " by "
& Err.Source & " at line " & Erl(), vbOKOnly, "Error in procedure
Form_current"
Resume exit_here
End Select
End Sub
Sub getFileName()
'Displays the office file open dialog to choose a file
'name for the current record. If the user selects a file
'display it in the image control.
Dim fileName As String
Dim result As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Select Picture"
.Filters.Add "All Files", "*.*"
.Filters.Add "JPEGs", "*.jpg"
.Filters.Add "Bitmaps", "*.bmp"
.FilterIndex = 3
.AllowMultiSelect = False
.InitialFileName = CurrentProject.path
result = .Show
If (result <> 0) Then
fileName = Trim(.SelectedItems.Item(1))
Me![ImagePath].Visible = True
Me![ImagePath].SetFocus
Me![ImagePath].Text = fileName
Me![MATERIAL_CODE].SetFocus
Me![ImagePath].Visible = False
End If
End With
End Sub
Sub ShowErrorMessage()
'Display the errormsg label if the image file is not available.
If Not IsNull(Me!PHOTO) Then
errormsg.Visible = False
Else
errormsg.Visible = True
End If
End Sub
Function IsRelative(fname As String) As Boolean
'Return false if the file name contains a drive or UNC path
IsRelative = (InStr(1, fname, ":") = 0) And (InStr(1, fname, "\\")
= 0)
End Function
Sub hideImageFrame()
'Hide the image control
Me![ImageFrame].Visible = False
End Sub
Sub showImageFrame()
'Display the image control
Me![ImagePath].Visible = True
End Sub
Private Sub ImagePath_AfterUpdate()
'After selecting an image , display it.
On Error Resume Next
ShowErrorMessage
showImageFrame
If (IsRelative(Me!ImagePath) = True) Then
Me![ImageFrame].Picture = path & Me![ImagePath]
Else
Me![ImageFrame].Picture = Me![ImagePath]
End If
End Sub
Thanks in advance for your time!
