اذهب الي المحتوي
أوفيسنا

الردود الموصى بها

قام بنشر

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

 

عندي جدور مرفق هو كيف استطيع ضغط زر للاظهار مجلد لتحميل اكثر من صورة من الكمبيوتر لموظف و في جدول العمل اسطيع ان اشر على اسم الصورة تظهر لي في الخانة الثانية الصور

ملاحظة ممكن ان يكون بالماكرو اذا امكن و اذا بالاكواد اطلب منكم و العفو السماحة فقط بالشرح لان الاكواد لم اتعلمها بارك الله فيكم ....وشكرا

Database8.accdbFetching info...

قام بنشر (معدل)

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

تفضل اخي الكريم

Private Sub Text0_DblClick(Cancel As Integer)
            On Error Resume Next
            Dim fs, cf, strFolder
            
'            التأكد من وجود  مجلد المفرقات AttachmentX
            strFolder = CurrentProject.Path & "\" & "AttachmentX"
            Set fs = CreateObject("Scripting.FileSystemObject")
'            اذا كان مجلد المرفقات AttachmentX غير موجود يتم انشاءه
            If fs.FolderExists(strFolder) = False Then
                  MsgBox "تحذير !!! مجلد المرفقات غير موجود ! وسيتم انشائه ان شاء الله بجوار البرنامج", vbExclamation, "officena"
                  Set cf = fs.CreateFolder(strFolder)
            End If

'        عرض مربع حواري لاختيار الصورة
        Dim Fpathz As Variant
        With Application.FileDialog(3)
            .Title = "Choose File"
            .Filters.Clear
              .Filters.Clear
              .Filters.Add "png image", "*.png"
              .Filters.Add "jpg image", "*.jpg"
              .Filters.Add "jpeg image", "*.jpeg"
              .Filters.Add "pdf File", "*.pdf"
            .AllowMultiSelect = False
            .InitialFileName = ""
         If .Show = -1 Then
           Fpathz = .SelectedItems(1)
           
'            نقل الصورة الى مجلد المرفقات AttachmentX بنفس الامتداد
            Dim DBwithEXT, DBwithoutEXT As String
            Dim XXX As String
            XXX = fnAutoField()
            DBwithEXT = Dir(Fpathz)
            DBwithoutEXT = Left(DBwithEXT, Len(DBwithEXT) - 4)
            
            FileCopy Fpathz, Application.CurrentProject.Path & "\AttachmentX" & "\" & DBwithoutEXT & XXX & "+" & [IdEmp] & Right(DBwithEXT, 4)
            Me.Text0 = Application.CurrentProject.Path & "\AttachmentX" & "\" & DBwithoutEXT & XXX & "+" & [IdEmp] & Right(DBwithEXT, 4)
 
               
         End If
         End With
End Sub

وهذا لتوليد رقم عشوائي للمرفقات

Function fnAutoField() As String
    Dim strRndNo As String
        strRndNo = Format((999999999 * Rnd) + 1, "0000000000")
        fnAutoField = strRndNo
End Function

 

Database8.rarFetching info...

تحياتي

تم تعديل بواسطه محمد أبوعبدالله
اضافة شرح مبسط للكود
قام بنشر

حبيبي المرفق لايوجد فيه الملف بعد التعديل -- انظر الى المرفقات 

اسال العلي القدير ان يحفظك و يبارك لك في والديك و كل من يعز قلبك ان تشرح لي طرقة العمل لاني لااعرف شي في الاكود ... اسال رب العرش القدير و ان يحفظكم من كل سوء وهو السميع العليم

قام بنشر

شكر اً...شكر اً...شكر اً...شكر اً...شكر اً...شكر اً...شكر اً... اسال العلي القدير ان يحفظك و يحفظ  كل من يعز على قلبك و اهلي المنتدء

طلب اخر و انا سف على ازعاجك ( اريد حماية الجدول الصور من العبث و الحذف الغير مقصود وشكرا

قام بنشر

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

  في 18‏/1‏/2021 at 04:05, ابوعبدالله_1972 said:

طلب اخر و انا سف على ازعاجك ( اريد حماية الجدول الصور من العبث و الحذف الغير مقصود وشكرا

Expand  

بعد انهاء البرنامج قم بعمل واجهة رئيسية للبرنامج واخفي اطار اكسيس بالكامل واعرض نموذج الرئيسية فقط ومن خلاله تنقل بين النماذج

ويمكنك استخدام الكود التالي لتنفيذ ذلك

تحياتي

  • Haha 1
  • تمت الإجابة
قام بنشر
  في 18‏/1‏/2021 at 04:17, ابوعبدالله_1972 said:

اريد حميتها بعد ادخال المسار ممكن تساعدني 🥰

Expand  

اخي الكريم بمجرد ان تخفي شاشة الاكسيس فانت قمت بحماية بنسبة كبيرة

وحماية الجداول وقاعدة البيانات لها اكثر من طريقة اكتب في محرك البحث حماية ستظهر لك نتائج كثيرة

https://www.officena.net/ib/search/?q=حماية&quick=1&type=forums_topic&nodes=89

اعتقد ان المشكلة التي معك حاليا كيفية حماية مجلد المرفقات

تحياتي

  • Haha 1
  • 1 month later...
قام بنشر

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

اشكر الله ثم اشكرك جميعا و خاصة للاستاذ الغالي محمد ابوعبدالله ... و الله العظيم ما اخرني عن ارسال الرساله الا مرضي تنومت في المستشفي القلب 5 اسابيع بعد علمية القسطرة

--- اكمل جميلك بارك الله فيكم ... اريد اضافة الي تحميل الملفات من صور GIf و تظهر متحركه و تحميل مقاطع الفيديو بكب انواعه و الصوتيات كذلك ... ارجو منك و من الجميع الا تتاخرو على برد 

بارك الله فيكم و عزكم و رفع رايتكم و شكرا ً اخوكم ابوعبدالله

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information