برجاء المساعدة ( طلب وضع صورة لكل موظف )

[prince30003]

الاخوة الكرام المحترمين

امل مساعدتكم 

عندي برنامج شئون موظفين وكنت محتاج اضيف عليه صورة الموظف وتتغير مع كل اسم

بالله عليكم من عنده المعرفة يساعدني

 

 

الباسورد: 1983

http://www.mediafire.com/download/a3eyqjkcb1hv1g9/%D9%85%D8%A4%D8%B3%D8%B3%D8%A9+%D9%85%D8%B8%D9%81%D8%B1+%D8%AC%D9%81%D9%8A%D9%83+%D9%84%D9%84%D8%A7%D8%B9%D9%85%D8%A7%D9%84+%D8%A7%D9%84%D8%A7%D9%86%D8%B4%D8%A7%D8%A6%D9%8A%D8%A9+%D8%A7%D9%84%D9%85%D8%AA%D8%AE%D8%B5%D8%B5%D8%A9.rar

 

[kamel2711]

سلام عليكم  مناك طريقتين

اسم           الحقل    objet olel 1

 ,   انشاء       زر      يفتح    المكتب  واختيار  الصورة  المناسبة لكل موظف 2

[علي المصري]

السلام عليكم ورحمة الله وبركاته

المرفق هو جزء من قاعدة بيانات خاصة بي ولكن الكود ليس من تأليفي

ولكنه لاحد من أعضاء المنتدى ومنتديات اخرى

هذه هي الاكواد المستخدمة بالإضافة إلى وحدة نمطية موجود في المرفق

Private Sub cmdErasePic_Click()
  If Not IsNull([ImagePath]) Then
    If MsgBox("هل تريد بالتأكيد استبدال هذه الصورة ؟", vbYesNo + vbQuestion, "") = vbYes Then
      [Image48].Picture = ""
      [ImagePath] = Null
      SysCmd acSysCmdClearStatus
    End If
  End If

End Sub

Private Sub cmdInsertPic_Click()
  Dim OFN As OPENFILENAME
  On Error GoTo Err_cmdInsertPic_Click

  With OFN
    .lpstrTitle = "Images"
    If Not IsNull([ImagePath]) Then .lpstrFile = [ImagePath]
    .flags = &H1804
    .lpstrFilter = MakeFilterString("Image files (*.bmp;*.gif;*.jpg;*.wmf)", "*.bmp;*.gif;*.jpg;*.wmf", _
      "All files (*.*)", "*.*")
  End With

  If OpenDialog(OFN) Then
    [ImagePath] = OFN.lpstrFile
    [Image48].Picture = [ImagePath]
    SysCmd acSysCmdSetStatus, "Afbeelding: '" & [ImagePath] & "'."
  End If
  Exit Sub

Err_cmdInsertPic_Click:
  MsgBox Err.Description, vbExclamation

End Sub

Private Sub Form_Current()
If Not Me.NewRecord Then
   
13   On Error GoTo HandleErr

14   If Not IsNull([ImagePath]) Then

15     [Image48].Picture = [ImagePath]

16     SysCmd acSysCmdSetStatus, "Image: '" & [ImagePath] & "'."

17   Else

18     [Image48].Picture = ""

19     SysCmd acSysCmdClearStatus

20   End If

21   Exit Sub

22

23 HandleErr:

24   If Err = 2220 Then

25     [Image48].Picture = ""

26     SysCmd acSysCmdSetStatus, "Can't open image: '" & [ImagePath] & "'"

27   Else

28     MsgBox Err.Description, vbExclamation

29   End If
End If
End Sub

Option Compare Database
Option Explicit
Type OPENFILENAME
  lStructSize As Long
  hwndOwner As Long
  hInstance As Long
  lpstrFilter As String
  lpstrCustomFilter As String
  nMaxCustFilter As Long
  nFilterIndex As Long
  lpstrFile As String
  nMaxFile As Long
  lpstrFileTitle As String
  nMaxFileTitle As Long
  lpstrInitialDir As String
  lpstrTitle As String
  flags As Long
  nFileOffset As Integer
  nFileExtension As Integer
  lpstrDefExt As String
  lCustData As Long
  lpfnHook As Long
  lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
  "GetOpenFileNameA" (OFN As OPENFILENAME) As Boolean

Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias _
  "GetSaveFileNameA" (OFN As OPENFILENAME) As Boolean

Private Const ALLFILES = "All files"

Function MakeFilterString(ParamArray varFilt() As Variant) As String
  Dim strFilter As String
  Dim intRes As Integer
  Dim intNum As Integer

  intNum = UBound(varFilt)
  If (intNum <> -1) Then
    For intRes = 0 To intNum
      strFilter = strFilter & varFilt(intRes) & vbNullChar
    Next
    If intNum Mod 2 = 0 Then
      strFilter = strFilter & "*.*" & vbNullChar
    End If

    strFilter = strFilter & vbNullChar
  End If

  MakeFilterString = strFilter
End Function

Private Sub InitOFN(OFN As OPENFILENAME)
  With OFN
    .hwndOwner = hWndAccessApp
    .hInstance = 0
    .lpstrCustomFilter = vbNullString
    .nMaxCustFilter = 0
    .lpfnHook = 0
    .lpTemplateName = 0
    .lCustData = 0
    .nMaxFile = 511
    .lpstrFileTitle = String(512, vbNullChar)
    .nMaxFileTitle = 511
    .lStructSize = Len(OFN)
    If .lpstrFilter = "" Then
      .lpstrFilter = MakeFilterString(ALLFILES)
    End If
    .lpstrFile = .lpstrFile & String(512 - Len(.lpstrFile), vbNullChar)
  End With
End Sub

Function OpenDialog(OFN As OPENFILENAME) As Boolean
  Dim intRes As Integer
  InitOFN OFN
  intRes = GetOpenFileName(OFN)
  If intRes Then
    With OFN
      .lpstrFile = Left$(.lpstrFile, InStr(.lpstrFile, vbNullChar) - 1)
    End With
  End If
  OpenDialog = intRes
End Function

 

AliElmasry.rar

[kamel2711]

طريقة 2

 للاظافة  نوع  صورة  نصي قي قاعدة بيانات    المرفق  تفضل

 

صور ادرلج.rar

[prince30003]

مشكووووووووووووووووووور لكم جميعا

[prince30003]

برجاء المساعدة

حاولت ادراج الصور ولكني فشلت ارجوا المساعدة

[kamel2711]

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

     و  كدلك   أنظر   الى  قاعدة بيانات    نوع   الصورة   (الحقل)  نصي    ثم  اختر   المسار الصحيخ   للصورة