ارجو المساعدة في ادارج صورة الموظف في لبفورم وتحفظ

[‫فرست احمد‬‎]

السلام عليكم اخواني الاعزاء 

اخوكم محتاج 

صممت برنامج في جميع المعلومات ولكن اريد ادراج صورة لكل موظف في الفورم وبحيث تحفظ 

اكون ممنون من الاخوة في المساعدة 

جربت العديد من الكودات ولكن تكون خطأ فارجوا المساعدة 

[sayed093]

السلام عليكم

لابد من استخدام Webutil .

[‫فرست احمد‬‎]

اخي الكريم 

اشكرك جزيل الشكر 

لقد قمت بكتابة الكود الصحيح ولكن عند اتخاذ الصورة لا تدخل المربع المخصص ولا تظهر في الفورم ولاكن موجودة في الجدول 

هذا هو الكود 

Private Sub Command35_Click()
Dim strFilter As String
   Dim lngflags As Long
   Dim varFileName As Variant


   strFilter = "All Files (*.*)" & vbNullChar & "*.*" _
    & vbNullChar & "All Files (*.*)" & vbNullChar & "*.*"
    
   lngflags = tscFNPathMustExist Or tscFNFileMustExist _
    Or tscFNHideReadOnly
   
   varFileName = tsGetFileFromUser( _
   fOpenFile:=True, _
   strFilter:=strFilter, _
   rlngflags:=lngflags, _
   strDialogTitle:=" الرجاء اختيار ملف ")
  
   
   If IsNull(varFileName) Then
    Else
      Me![imagePath] = varFileName
   End If


cmdAdd_End:
   On Error GoTo 0
   Exit Sub


cmdAdd_Err:
   Beep
   MsgBox Err.Description, , "Error: " & Err.Number _
    & " in file"
   Resume cmdAdd_End
  
End Sub
هو كود زر اختيار الصورة 
وهذا هو اسم المربع الذي يجب ان تكون الصورة فيه img 
وهذا كود الوحدات النمطية العام هو 
Option Compare Database
Option Explicit
Private Declare Function ts_apiGetOpenFileName Lib "comdlg32.dll" _
 Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean


Private Declare Function ts_apiGetSaveFileName Lib "comdlg32.dll" _
 Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean


Private Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long


Private Type tsFileName
   lStructSize As Long
   hwndOwner As Long
   hInstance As Long
   strFilter As String
   strCustomFilter As String
   nMaxCustFilter As Long
   nFilterIndex As Long
   strFile As String
   nMaxFile As Long
   strFileTitle As String
   nMaxFileTitle As Long
   strInitialDir As String
   strTitle As String
   flags As Long
   nFileOffset As Integer
   nFileExtension As Integer
   strDefExt As String
   lCustData As Long
   lpfnHook As Long
   lpTemplateName As String
End Type


' Flag Constants
Public Const tscFNAllowMultiSelect = &H200
Public Const tscFNCreatePrompt = &H2000
Public Const tscFNExplorer = &H80000
Public Const tscFNExtensionDifferent = &H400
Public Const tscFNFileMustExist = &H1000
Public Const tscFNPathMustExist = &H800
Public Const tscFNNoValidate = &H100
Public Const tscFNHelpButton = &H10
Public Const tscFNHideReadOnly = &H4
Public Const tscFNLongNames = &H200000
Public Const tscFNNoLongNames = &H40000
Public Const tscFNNoChangeDir = &H8
Public Const tscFNReadOnly = &H1
Public Const tscFNOverwritePrompt = &H2
Public Const tscFNShareAware = &H4000
Public Const tscFNNoReadOnlyReturn = &H8000
Public Const tscFNNoDereferenceLinks = &H100000


Public Function tsGetFileFromUser( _
 Optional ByRef rlngflags As Long = 0&, _
 Optional ByVal strInitialDir As String = "", _
 Optional ByVal strFilter As String = "All Files (*.*)" & vbNullChar & "*.*", _
 Optional ByVal lngFilterIndex As Long = 1, _
 Optional ByVal strDefaultExt As String = "", _
 Optional ByVal strFileName As String = "", _
 Optional ByVal strDialogTitle As String = "", _
 Optional ByVal fOpenFile As Boolean = True) As Variant
   
   On Error GoTo tsGetFileFromUser_Err
   Dim tsFN As tsFileName
   Dim strFileTitle As String
   Dim fResult As Boolean


   ' Allocate string space for the returned strings.
   strFileName = Left(strFileName & String(256, 0), 256)
   strFileTitle = String(256, 0)


   ' Set up the data structure before you call the function
   With tsFN
      .lStructSize = Len(tsFN)
      .hwndOwner = Application.hWndAccessApp
      .strFilter = strFilter
      .nFilterIndex = lngFilterIndex
      .strFile = strFileName
      .nMaxFile = Len(strFileName)
      .strFileTitle = strFileTitle
      .nMaxFileTitle = Len(strFileTitle)
      .strTitle = strDialogTitle
      .flags = rlngflags
      .strDefExt = strDefaultExt
      .strInitialDir = strInitialDir
      .hInstance = 0
      .strCustomFilter = String(255, 0)
      .nMaxCustFilter = 255
      .lpfnHook = 0
   End With
   
   ' Call the function in the windows API
   If fOpenFile Then
      fResult = ts_apiGetOpenFileName(tsFN)
   Else
      fResult = ts_apiGetSaveFileName(tsFN)
   End If


   ' If the function call was successful, return the FileName chosen
   ' by the user. Otherwise return null. Note, the CancelError property
   ' used by the ActiveX Common Dialog control is not needed.  If the
   ' user presses Cancel, this function will return Null.
   If fResult Then
      rlngflags = tsFN.flags
      tsGetFileFromUser = tsTrimNull(tsFN.strFile)
   Else
      tsGetFileFromUser = Null
   End If
   
tsGetFileFromUser_End:
   On Error GoTo 0
   Exit Function


tsGetFileFromUser_Err:
   Beep
   MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsGetFileFromUser"
   Resume tsGetFileFromUser_End


End Function


' Trim Nulls from a string returned by an API call.


Private Function tsTrimNull(ByVal strItem As String) As String
   
   On Error GoTo tsTrimNull_Err
   Dim I As Integer
   
   I = InStr(strItem, vbNullChar)
   If I > 0 Then
       tsTrimNull = Left(strItem, I - 1)
   Else
       tsTrimNull = strItem
   End If
    
tsTrimNull_End:
   On Error GoTo 0
   Exit Function


tsTrimNull_Err:
   Beep
   MsgBox Err.Description, , "Error: " & Err.Number _
    & " in function basBrowseFiles.tsTrimNull"
   Resume tsTrimNull_End


End Function

فارجو من الاخوان بيان الخطأ الموجود في الكود 

[eslam elbyaly]

I think you are talking about ADF .
Move the thread to the dedicated forum .