انشاء مجلد يحمل رقم السجل

[محمد التميمي]

السلام عليكم

طيب الله اوقاتكم بالخير

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

المطلوب اخواني :  التعديل على كود (اضافة كتاب) وجعله يفتح فولدر جديد في داخل  Books ويسمي الجديد برقم السجل ويحفظ الصورة  المتعلقة يالسجل في الفولدر الجديد

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

قاعدة.rar

[kkhalifa1960]

تفضل أخي انشاء الله يفي بالمطلوب 

من فضلك وافني بالنتيجة !!!

قاعدة.rar

[محمد التميمي]

5 ساعات مضت, kkhalifa1960 said:

تفضل أخي انشاء الله يفي بالمطلوب 

من فضلك وافني بالنتيجة !!!

قاعدة.rar 77.82 kB · 4 downloads

شاكر فضلك اخي الكريم نعم هذا هو المطلوب 

•  

[محمد التميمي]

في 13‏/11‏/2022 at 01:09, kkhalifa1960 said:

 

السلام عليكم

اخي الكريم kkhalifa1960 الكود الذي ارسلته لي من خلال المثال يعمل بشكل جيد ولاكن عندما قمت بنقله الى القاعدة الاصلية اصبح لا يعمل وانا طالب علم بسيط لست بارعاً بالتعديل على الاكواد.

المطلوب اخي الكريم:

 فتح نموذج Personnel ومن ثم نموذج Bookss من زر (الكتب الرسمية) ومن ثم نموذج InComming من زر (ارني كتاب)  في ((نموذج InComming هنا اوريد الكود ان يعمل في زر (اضافة كتاب).)) نقلت الكود الى هذا الموقع ولم يعمل ارجو المساعدة من خلال الملف الاصلي المرفق.

مع جزيل الشكر والامتنان

 

thaeer.rar

[سامي الحداد]

السلام عليكم أخي الكريم

تفضل الملف بعد التعديل كان ناقص فقط الكود التالي الظاهر انك نسيت ان تنقله الى برنامجك.

Public Function MakeDir(ByVal strPath As String) As Boolean
On Error GoTo err_Handler
   'Check if rightmost char is a \
       If Right(strPath, 1) = "\" Then
         'Strip it
         strPath = Left(strPath, Len(strPath) - 1)
       End If
   'Check if each individual directory exists, and if not, create it
       Dim strSplitPath() As String
       strSplitPath = Split(strPath, "\")
       Dim intI As Integer
       Dim strCombined As String
   'Loop through, creating each directory if needed
         For intI = 0 To UBound(strSplitPath)
           If intI <> 0 Then
               strCombined = strCombined & "\"
           End If
           strCombined = strCombined & strSplitPath(intI)
             If Dir(strCombined, vbDirectory) = "" Then
               MkDir strCombined
             End If
         Next
   'Code ran to end without errors, so creation was succesfull
       MakeDir = True
     Exit Function
err_Handler:
   MakeDir = False
   MsgBox "Error " & Err.Number & " occured." & vbNewLine & Err.Description
End Function

واليك الملف بعد الإضافة 

طبعا الشكر موصول للاخ خليفه على الكود

تحياتي لك وبالتوفيق إن شاء الله.

thaeer.rar

[Ahmed_J]

السلام عليكم

لي مداخلة صغيره

المفروض ان الكتاب يحفظ برقمه وتاريخة وليس عنوانه  لان العناوين تتكرر

تحياتي للجميع

 

[محمد التميمي]

الان, سامي الحداد said:

السلام عليكم أخي الكريم

تفضل الملف بعد التعديل كان ناقص فقط الكود التالي الظاهر انك نسيت ان تنقله الى برنامجك.

Public Function MakeDir(ByVal strPath As String) As Boolean
On Error GoTo err_Handler
   'Check if rightmost char is a \
       If Right(strPath, 1) = "\" Then
         'Strip it
         strPath = Left(strPath, Len(strPath) - 1)
       End If
   'Check if each individual directory exists, and if not, create it
       Dim strSplitPath() As String
       strSplitPath = Split(strPath, "\")
       Dim intI As Integer
       Dim strCombined As String
   'Loop through, creating each directory if needed
         For intI = 0 To UBound(strSplitPath)
           If intI <> 0 Then
               strCombined = strCombined & "\"
           End If
           strCombined = strCombined & strSplitPath(intI)
             If Dir(strCombined, vbDirectory) = "" Then
               MkDir strCombined
             End If
         Next
   'Code ran to end without errors, so creation was succesfull
       MakeDir = True
     Exit Function
err_Handler:
   MakeDir = False
   MsgBox "Error " & Err.Number & " occured." & vbNewLine & Err.Description
End Function

واليك الملف بعد الإضافة 

طبعا الشكر موصول للاخ خليفه على الكود

تحياتي لك وبالتوفيق إن شاء الله.

thaeer.rar 52.09 kB · 11 downloads

السلام عليكم اخي الفاضل (سامي الحداد) شاكر فضلك وممنون جداً من جنابكم الكريم الكود يعمل بامتياز

(( ليس العيب ان نقول لا نعرف ولاكن العيب ان لا نتعلم )) انا لم انسى الكود ولاكن لا اعرفعه كوني لدية معلومات بسيطة عن بناء الاكواد ومنكم نتعلم... 

شكرا جزيلا

الان, Ahmed_J said:

السلام عليكم

لي مداخلة صغيره

المفروض ان الكتاب يحفظ برقمه وتاريخة وليس عنوانه  لان العناوين تتكرر

تحياتي للجميع

 

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

اخي العزيز Ahmed المحترم نعم صحيح يكون حفظ الكتب بالرقم والتاريخ ولكن صديقي العزيز طلب مني الحفظ باسم الكتاب

تحيلتي اخي الكريم

 

[سامي الحداد]

13 ساعات مضت, محمد التميمي said:

السلام عليكم اخي الفاضل (سامي الحداد) شاكر فضلك وممنون جداً من جنابكم الكريم الكود يعمل بامتياز

(( ليس العيب ان نقول لا نعرف ولاكن العيب ان لا نتعلم )) انا لم انسى الكود ولاكن لا اعرفعه كوني لدية معلومات بسيطة عن بناء الاكواد ومنكم نتعلم... 

شكرا جزيلا

وعليكم السلام اخي الكريم محمد 

الفضل والشكر لله سبحانه وتعالى ولهذا المنتدى الكريم .

نحن هنا جميعا نتعلم ونساعد بعضنا البعض .

(( ليس العيب ان نقول لا نعرف ولاكن العيب ان لا نتعلم ))  أحسنت بارك الله فيك.

تحياتي لك