المساعدة في فتح صورة من ListBox

[bakry kassala]

التحية والاحترام لكم أعزائي  ملتقى اوفيسنا العربي

في المرفقات نموذج فارغ لوضع الاكواد اللازمة لتحقيق الفكرة التالية :

1 مسار لعرض جميع صور الموظف بجميع الصيغ حسب الرقم الوظيفي 

2 سرد هذه الصور اعلاه في مربع القائمة

3 بالضغط على اسم الصورة في مربع القائمة يتم عرضها في اطار الصور 

أتمنى أكون وفقت في شرح الطلب ..

 

imageListBox.rar

[jjafferr]

وعليكم السلام 

 

ايش رايك ، حذفت حقل مسار الصورة:

.

وحذفت زر فتح الصورة:

.

وهذا هو كود النموذج كاملا:

Option Compare Database

Private Sub clase_form_Click()

    DoCmd.Close
End Sub

Private Sub Form_Current()

    Dim imagepath As String
    
   '1
    imagepath = Application.CodeProject.Path
    
   '2
    imagepath = imagepath & "\Photo\"
    'if the photo Dir dose not exist, creat it
    If Dir(imagepath, vbDirectory) = "" Then
        MkDir imagepath
    End If
    
   '3
    imagepath = imagepath & [E_number] & "\"
    'if the [code] Dir dose not exist, creat it
    If Dir(imagepath, vbDirectory) = "" Then
        MkDir imagepath
    End If
    
    
    'Place the imagepath in the listbox tag
    Me.lst_Files.Tag = imagepath
    
    'cleaning up
    Me.lst_Files.RowSourceType = "Value List"
    Me.lst_Files.RowSource = ""
    Me.imageframe.Picture = ""
    
    'Directory file to the listbox
    strFile = Dir(imagepath & "*.*")
    Do Until strFile = ""
        Me.lst_Files.AddItem Item:=strFile
        strFile = Dir()
    Loop
    
End Sub


Private Sub lst_Files_Click()

    'show the picture
    Me.imageframe.Picture = Me.lst_Files.Tag & Me.lst_Files
End Sub

 

جعفر

296.imageListBox.accdb.zip

[bakry kassala]

استاذي الفاضل جعفر

كلمة شكراً لا توفيك حقك .. ولكني أشكرك شكراً جزيلاً ..من لا يشكر الناس لا يشكر الله .. وادعو الله ان يجزيك الخير كله ويحفظك ..

لقد اخذت أنا هذه الفكرة من أحد إبداعاتك في الآكسس ولكن كانت الاكوادمرتبطة بوحدات برمجية معقدة .. ولم استطع استخراجها ..

الآن وقد أعددت لنا النموذج بهذه الطريقة السهلة والبسيطة .. بارك الله فيك ..

أكرر شكري وتقديري لك 

[jjafferr]

حياك الله 

 

البارحة لما نظرت الى الكود ، قلت في نفسي ان هذا الكود لي ، فهي طريقتي في البرمجة (يعني عرفت اميّز خط يدي ) ، وبنفس طريقة التنسيق التي اتبعها 

 

 

جعفر

[bakry kassala]

لك التحية أستاذي جعفر ..

 مساعدتك أيضأ وأكمل جميلك لإضافة زر لفتح الصورة وآخر لتعديل اسم الصورة المحددة من القائمة .. كما في برنامجك السابق ولكن دون وحدات برمجية ..

تقبل كامل احترامي 

[jjafferr]

13 دقائق مضت, bakry kassala said:

1. لإضافة زر لفتح الصورة

2. وآخر لتعديل اسم الصورة المحددة من القائمة ..

ولكن دون وحدات برمجية

1. ما عملها ، حيث الصورة تُعرض في النموذج بدون الزر ،

2. 

يعني انتشر الخبر اني عُماني وساحر وبدون برمجة 

 

جعفر

[bakry kassala]

55 دقائق مضت, jjafferr said:

1. ما عملها ، حيث الصورة تُعرض في النموذج بدون الزر ،

2. 

يعني انتشر الخبر اني عُماني وساحر وبدون برمجة 

 

جعفر

استاذي جعفر ..

هل تذكر هذا البرنامج ( الصورة المرفقة )

 

[jjafferr]

ذكرتني بأيام زمان 

والايام اللي تبعته

 

ما كنت ادري انك تشوف المستخبري كمان  ، لازم اخلي بالي المرات الجاية 

 

الكود اصبح:

Option Compare Database

Private Sub clase_form_Click()

    DoCmd.Close
End Sub

Private Sub cmd_open_a_File_Click()
    
    'open the file outside the program
    Application.FollowHyperlink Me.lst_Files.Tag & Me.lst_Files.ItemData(Me.lst_Files.ListIndex)
    
End Sub

Private Sub cmd_Rename_Click()

    newpathANDname1 = InputBox("Please insert a new name")
    If Len(newpathANDname1 & "") = 0 Then Exit Sub
    
    newpathANDname = Me.lst_Files.Tag & newpathANDname1 & ".jpg"
    oldpathANDname = Me.lst_Files.Tag & Me.lst_Files.ItemData(Me.lst_Files.ListIndex)
    
    'make a copy of the fie, with the new name
    FileCopy oldpathANDname, newpathANDname
    
    'select another file in the listbox, so that this file is no longer in-use
    For i = 0 To lst_Files.ListCount - 1
        If lst_Files.Column(0, i) <> newpathANDname1 Then
            Me.lst_Files.Selected(i) = True
            Exit For
        End If
    Next i
    
    
    'now delete the old file name
    Kill oldpathANDname
    
    'don't refresh the Form
    Me.Painting = False
    
    'read the folder files
    Call Form_Current
    
    'select the same file name
    For i = 0 To lst_Files.ListCount - 1
        If lst_Files.Column(0, i) = newpathANDname1 Then
            Me.lst_Files.Selected(i) = True
            Exit For
        End If
    Next i
    
    'refresh the Form
    Me.Painting = True
    
End Sub

Private Sub Form_Current()

    Dim imagepath As String
    
   '1
    imagepath = Application.CodeProject.Path
    
   '2
    imagepath = imagepath & "\Photo\"
    'if the photo Dir dose not exist, creat it
    If Dir(imagepath, vbDirectory) = "" Then
        MkDir imagepath
    End If
    
   '3
    imagepath = imagepath & [E_number] & "\"
    'if the [code] Dir dose not exist, creat it
    If Dir(imagepath, vbDirectory) = "" Then
        MkDir imagepath
    End If
    
    
    'Place the imagepath in the listbox tag
    Me.lst_Files.Tag = imagepath
    
    'cleaning up
    Me.lst_Files.RowSourceType = "Value List"
    Me.lst_Files.RowSource = ""
    Me.imageframe.Picture = ""
    
    'Directory file to the listbox
    strFile = Dir(imagepath & "*.*")
    Do Until strFile = ""
        Me.lst_Files.AddItem Item:=strFile
        strFile = Dir()
    Loop
    
End Sub


Private Sub lst_Files_Click()

    'show the picture
    Me.imageframe.Picture = Me.lst_Files.Tag & Me.lst_Files
End Sub

 

جعفر

 

 

 

296.imageListBox.accdb.zip

[bakry kassala]

ما شاء الله تبارك الله ..

ايها الساحر العُماني بار ك الله فيك ..

إحترامي

[jjafferr]

 

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

فالسؤال هو : اذا فتحت ملف اكسس مثلا ، فهل تستطيع ان تغير اسمه وهو مفتوح؟

الجواب لا ،

فهنا انا ، غيرت اختيار الصورة (يعني كأنّي كبست على صورة ثانية)

'select another file in the listbox, so that this file is no longer in-use

عندها ، طلبت من الاكسس ان لا يسمح لك ان ترى ما يحدث (يعني لما اكبس الزر لرؤية صورة اخرى ، فالمفروض ترى صورة اخرى في النموذج ، مما قد يربك المستخدم) ، وذلك بعدم تغيير آخر شكل للنموذج ، والامر هو Me.Painting = False ،

وعندها عملت التغييرات ، ولما خلصت ، طلبت من اكسس ان يعرض الشكل الصحيح للنموذج Me.Painting = True

 

للعلم 

 

جعفر

[bakry kassala]

ما شاء الله تبارك الله

قلت لك انك ساحر ..

ما شاء الله تبارك الله

Private Sub cmd_Rename_Click()

    newpathANDname1 = InputBox("Please insert a new name")
    If Len(newpathANDname1 & "") = 0 Then Exit Sub
    
    newpathANDname = Me.lst_Files.Tag & newpathANDname1 & ".jpg"
    oldpathANDname = Me.lst_Files.Tag & Me.lst_Files.ItemData(Me.lst_Files.ListIndex)
    
    'make a copy of the fie, with the new name
    FileCopy oldpathANDname, newpathANDname
    
    'select another file in the listbox, so that this file is no longer in-use
    For i = 0 To lst_Files.ListCount - 1
        If lst_Files.Column(0, i) <> newpathANDname1 Then
            Me.lst_Files.Selected(i) = True
            Exit For
        End If
    Next i
    
    
    'now delete the old file name
    Kill oldpathANDname
    
    'don't refresh the Form
    Me.Painting = False
    
    'read the folder files
    Call Form_Current
    
    'select the same file name
    For i = 0 To lst_Files.ListCount - 1
        If lst_Files.Column(0, i) = newpathANDname1 Then
            Me.lst_Files.Selected(i) = True
            Exit For
        End If
    Next i
    
    'refresh the Form
    Me.Painting = True
    
End Sub

كود عبقري يدرس ..

[محمد سلامة]

ماشاء الله استاذ جعفر

بارك الله فيك

 

[jjafferr]

آسف ياشباب نسيت اخبركم ، انا عملت موضوع مستقل لمثال عن Me.Painting على الرابط التالي:

http://www.officena.net/ib/topic/67520-تجديد-تحديث-النموذج-mepainting/

 

جعفر

[xbox2007]

السلام عليكم

جزاكم الله خير

بس فى سؤال او اقتراح ؟؟؟

كيف يتم ادراج هذه الصور  ؟؟؟؟؟

انا ادرجتها يدويا فى الفولدر الخاص برقم الموظف

انا اتمنى او اقترح لو فى اضافه  ( زر لاضافه الصوره من جهاز الكمبيوتر ) و ( زر اخر لاضافتها من جهاز اللأسكنر و تحميلها فى الفولدر الخاص بالرقم )

 

اتمنى لكم التوفيق