أبو آدم

قيد النظر .... .........

تفضل على إخوتك بمشاركة ما حصلت عليه ... فضلاً وليس أمراً .........

طريقة إنشاء مجلد برقم السجل ... كطلب الأخ بسيط وكريم وتطبيق العبد الفقير الى رحمة ربه نارت لبزو / أبو آدم http://www.officena.net/ib/index.php?showtopic=45643 .........

بإنتظار ردّك وتطبيقك ... ............ تم تطبيق الروتين و الكودات بأعلاه وهي تعمل بشكل ممتاز Routine and codes have been tested ... working perfectly ...........

ننشيئ وحدة نمطية جديدة ، وننسخ اليها Option Compare Database Private Declare Function apiShellExecute Lib "shell32.dll" _ Alias "ShellExecuteA" _ (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Long) _ As Long '***App Window Constants*** Public Const WIN_NORMAL = 1 'Open Normal Public Const WIN_MAX = 2 'Open Maximized Public Const WIN_MIN = 3 'Open Minimized '***Error Codes*** Private Const ERROR_SUCCESS = 32& Private Const ERROR_NO_ASSOC = 31& Private Const ERROR_OUT_OF_MEM = 0& Private Const ERROR_FILE_NOT_FOUND = 2& Private Const ERROR_PATH_NOT_FOUND = 3& Private Const ERROR_BAD_FORMAT = 11& Function fHandleFile(stFile As String, lShowHow As Long) Dim lRet As Long, varTaskID As Variant Dim stRet As String 'First try ShellExecute lRet = apiShellExecute(hWndAccessApp, vbNullString, _ stFile, vbNullString, vbNullString, lShowHow) If lRet > ERROR_SUCCESS Then stRet = vbNullString lRet = -1 Else Select Case lRet Case ERROR_NO_ASSOC: 'Try the OpenWith dialog varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " _ & stFile, WIN_NORMAL) lRet = (varTaskID <> 0) Case ERROR_OUT_OF_MEM: stRet = "Error: Out of Memory/Resources. Couldn't execute!" Case ERROR_FILE_NOT_FOUND: stRet = "Error: File not found. Couldn't Execute!" Case ERROR_PATH_NOT_FOUND: stRet = "Error: Path not found. Couldn't Execute!" Case ERROR_BAD_FORMAT: stRet = "Error: Bad File Format. Couldn't Execute!" Case Else: End Select End If fHandleFile = lRet & _ IIf(stRet = "", vbNullString, ", " & stRet) End Function

ننشيئ زر أمر E_File في النموذج Emp Data ، وخلف حدث عند الضغط يتم وضع الكود Private Sub E_File_Click() On Error GoTo Err_E_File_Click Dim fs As Object Dim a As Object Set fs = CreateObject("Scripting.FileSystemObject") If fs.FolderExists(Me.txtloc & "\" & Me.EMP_NO) = True Then ' MsgBox "Folder exists" Call fHandleFile(Nz(Me.txtloc & "\" & Me.EMP_NO, ""), 1) Else If MsgBox("Folder Not Found , A New Folder Will Be Created For The Employee ", vbOKCancel) = vbCancel Then Exit Sub Else Set a = fs.Createfolder(Me.txtloc & "\" & Me.EMP_NO) 'MsgBox "Folder was created" Call fHandleFile(Nz(Me.txtloc & "\" & Me.EMP_NO, ""), 1) End If End If Exit_E_File_Click: Exit Sub Err_E_File_Click: MsgBox Err.Description Resume Exit_E_File_Click End Sub

في مجلد التطبيق ننشيئ مجلد فارغ باسم Emp_Files نضيف مريع نص مخفي للنموذج نسميه txtloc في حدث (في الحالي للنموذج ) نضع الكود التالي Me.txtloc = CurrentProject.Path & "\Emp_Files"

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

تحية للأخ أحمد عبد الناصر وتحية للأخ محمد صدير أخي محمد تحليل الجداول مسألة مهمة وحساسة هناك أهمية كبيرة للجداول المساندة جدول الموظفين لا بد أن يرافقه مجموعة من الجداول المساندة الرتبة ( الدرجة ) يكون مستقى من جدول مساند الدرجة العلمية تستقى من جدول مساند .... وهكذا إهمال مثل هذه الجداول توصلنا لمثل هذه الحاجات ... لنعود إليها الأخ أحمد قدّم لك حلاً منهجياً دقق في الحلّ ... آثرت المشاركة للتوضيح والله من وراء القصد وهو حسبي ...........

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

مربعات التحرير والسرد المرتبطة http://youtu.be/-82BMn7UZ5M ........... التطبيقات المرفقة 2003 و 2007 .......... NA_ComboBox.rar

إخوتي الفضلاء إستجابة للحاجة ، وتحقيقاً لمطالب بعض الإخوة نبدأ ... بإذن الله وبحوله وقوته ، وبه نصول ونجول سلسلة مسجلة من المشاركات التي تضم تطبيقات وشروحات وحلولاً برمجية قدر المستطاع وقدر المتاح والله المستعان ونلتمس منكم العذر إن قصرنا أو سهونا أو أخطأنا ... فهذا جهد المقل المقصر ولسنا من أهل الإحتراف ... بل نجتهد في محيط القليل الذي نعرف والله من وراء القصد وهو حسبي

دعوة طيبة لطيب http://www.officena.net/ib/index.php?showannouncement=21&f=89 ..................

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

سأعيد النظر ... لكن التطبيق عندي يعمل بشكل مناسب .. ............

حدد نمط تسمية المجلد ... !! ............

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

تفضل أبو جاسم Private Sub Command10_Click() Me.SerchItemOriginal = "" Me.SerchItemName = "" Me.SerchItemID = "" Me.RecordSource = "QueryTabItems" End Sub

تم علاج تضخم قاعدة البيانات ، وتم إنشاء قاعدة جديدة بالمحتويات مرفق التطبيق بحجم 1 ميجا ............. New Employee DataBase 2007.rar

سنلتزم بالرّد على الموضوع المحدد بالعنوان ... اضافة الملفات والمجلدات برقم السجل ............

أولاً : دعوة طيبة لطيب http://www.officena.net/ib/index.php?showannouncement=21&f=89 ......... ثانياً : دعوة للإلتزام http://www.officena.net/Tips/Questions.htm ................

تفضل النماذج تعمل بشكل ممتاز NA_Nsb 2012.rar

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

تم تعديل عنوان الموضوع لتوضيح الدلالة حياك الله أبا عمر .............

أخي أبا عمر نرّد على عموم السؤال بعموم الرّد النموذج به مجموعة من العناصر ، نريد أن نمنع التعديل فيها ، بإستثاء واحد منها ....!! نذهب لمربع التحرير و السرد المعني (بعدم الاغلاق) ، نذهب لخصائص المربع ..... وفي آخرها Tag نضع عبارة DoNotLock ننشيئ وحدة نمطية جديدة في التطبيق ، ننسخ اليها Function LockUnlock(frm As Form, blnLock As Boolean) Dim ctl As Control For Each ctl In frm.Controls Select Case ctl.ControlType Case acTextBox, acComboBox, acListBox, acOptionGroup, acCheckBox If ctl.Tag <> "DoNotLock" Then ctl.Locked = blnLock Else ctl.Locked = False End If End Select Next End Function نذهب لمحرر الفيجوال للنموذج وننسخ اليه الكود Private Sub Form_Current() If Not Me.NewRecord Then LockUnlock Me, True End If End Sub نعيد تشغيل النموذج ونجرب النتائج وندعوا لأبي آدم بدعوة طيبة بظهر الغيب ....... والله من وراء القصد وهو حسبي ........