При указании в форме на файл с фото в таблицу пишеться весь путь к файлу
и имя файла , а хотелось бы только имя файла


Option Compare Database
Option Explicit
Dim path As String

Private Sub AddPicture_Click()
' Для выбора файла с фотографией сотрудника используется
' стандартное окно открытия файла Office.
getFileName
End Sub



Private Sub Form_RecordExit(Cancel As Integer)
' При переходе между записями надпись errormsg скрывается,
' чтобы ненужного избежать мелькания.
ErrorMsg.Visible = False
End Sub

Private Sub RemovePicture_Click()
' Очищает строку имени файла для записи сотрудника
' и выводит надпись errormsg.
Me![ImagePath] = ""
hideImageFrame
ErrorMsg.Visible = True
End Sub


Private Sub ImagePath_AfterUpdate()
' Отображает выбранную фотографию сотрудника.
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_Current()
' Если для записи текущего сотрудника имеется фотография,
' она отображается в форме. Если указанный файл не существует,
' либо если для текущего сотрудника поле имени файла пусто,
' надпись errormsg выводит соответствующее сообщение.
Dim res As Boolean
Dim fName As String

path = CurrentProject.path
On Error Resume Next
ErrorMsg.Visible = False
If Not IsNull(Me![Фотография]) Then
res = IsRelative(Me![Фотография])
fName = Me![ImagePath]
If (res = True) Then
fName = path & "\" & fName
End If

Me![ImageFrame].Picture = fName
showImageFrame
Me.PaintPalette = Me![ImageFrame].ObjectPalette
If (Me![ImageFrame].Picture <> fName) Then
hideImageFrame
ErrorMsg.Caption = "Фотография не найдена"
ErrorMsg.Visible = True
End If
Else
hideImageFrame
ErrorMsg.Caption = "Для добавления фотографии нажмите кнопку ""Добавить/изменить"""
ErrorMsg.Visible = True
End If

End Sub

Sub getFileName()
' Для выбора имени файла с фотографией текущего сотрудника
' используется стандартное окно открытия файла Office.
' Если пользователь указывает файл, его содержимое
' отображается в элементе управления ImageFrame.
Dim fileName As String
Dim result As Integer
With Application.FileDialog(msoFileDialogFilePicker)
.Title = "Выбор фотографии сотрудника"
.Filters.Add "Все файлы", "*.*"
.Filters.Add "JPEG", "*.jpg"
.Filters.Add "Рисунки", "*.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![Имя].SetFocus
Me![ImagePath].Visible = False
End If
End With
End Sub

Sub showErrorMessage()
' Выводит сообщение errormsg, если файл фотографии недоступен.
If Not IsNull(Me![Фотография]) Then
ErrorMsg.Visible = False
Else
ErrorMsg.Visible = True
End If
End Sub

Function IsRelative(fName As String) As Boolean
' Возвращает значение false, если имя файла включает
' имя диска или путь UNC.
IsRelative = (InStr(1, fName, ":") = 0) And (InStr(1, fName, "\\") = 0)
End Function

Sub hideImageFrame()
' Скрывает элемент управления с фотографией.
Me![ImageFrame].Visible = False
End Sub

Sub showImageFrame()
' Выводит элемент управления с фотографией.
Me![ImageFrame].Visible = True
End Sub

Private Sub Имя_BeforeUpdate(Cancel As Integer)

End Sub

Можно пример !!!

Извините за тупость я в VBA не очень разбираюсь можно показать на примере

мной выложенных данных

Что то не получаеться у меня ваши предложения

Что то не срабатывает

aleks2function GetFileName(aName as string) as string
Dim s as long, ss as long
s=1
ss=InStr(aName, "\")
while ss<>0
s=ss+1
ss=InStr(s, aName, "\")
wend
GetFileName=Mid(aName,s)
end function

Эта фунция у меня не работает выдает что она вызавает ошибку
Уважаемые спецы огромная просьба отнестись терпимее
Я же приложил свой код VBA
Что нужно в нем подправить
Простите за незнание языка

kedzo softmasterЧто то не срабатывает

что не срабатывает?
хорош уже прикалваться...


Мне будет наверное прислать вам файл базы он не большой 124 kb

Лох Позорный Эта фунция у меня не работает выдает что она вызавает ошибку
Там на неведомой дорожке
Следы невиданных зверей

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

Так что, товарисч софтмастер, придется вам сидеть и ждать дядю Васю.

Яже специально выложил свой код т.к не очень разбираюсь в VB
и помоему попросил помочь разобраться а не соревноваться в краснословии!!!

Лох ПозорныйДля мастеров - повторяю:
Где не работает, зачем не работает, где ошибка, какая ошибка - придет дядя Вася и раскажет.

Для тупых - объясняю.
Угадать на какой строчке возникает ошибка и какая именно ошибка - могут только телепяты.
А телепяты - в отпуске.

На вопрос:
Эта фунция у меня не работает выдает что она вызавает ошибку
можно дать разве что такой ответ
Поправь ошибку и у тебя все заработает.

При открытии формы для ввода пути к файлу выдает
Bыpaжeниe Teкyщaя зaпиcь, ввeдeннoe в пoлe cвoйcтвa coбытия, вызывaeт oшибкy:
Ambiguous name detected: GetFileName.
* Peзyльтaтoм выpaжeния нe являeтcя имя мaкpoca, имя фyнкции пoльзoвaтeля или cтpoкa [Пpoцeдypa
oбpaбoтки coбытий].
* Oшибкa пpи вычиcлeнии фyнкции, coбытия или мaкpoca.


после вставки :

function GetFileName(aName as string) as string
Dim s as long, ss as long
s=1
ss=InStr(aName, "\")
while ss<>0
s=ss+1
ss=InStr(s, aName, "\")
wend
GetFileName=Mid(aName,s)
end function

Лох ПозорныйДля мастеров - повторяю:
Где не работает, зачем не работает, где ошибка, какая ошибка - придет дядя Вася и раскажет.

Для тупых - объясняю.
Угадать на какой строчке возникает ошибка и какая именно ошибка - могут только телепяты.
А телепяты - в отпуске.

На вопрос:
Эта фунция у меня не работает выдает что она вызавает ошибку
можно дать разве что такой ответ
Поправь ошибку и у тебя все заработает.

Разреши тебе куда нибудь скинуть базу она 124 kb

А как было бы здорово если бы просто объяснили
Ну неврубаюсь я где собака порылась!!!!!