jjafferr

حياك الله أخي محمد عندك يومين تخبرني إذا أردت أي تعديل ، لأني بعدها مسافر مرة ثانية جعفر

عين العقل أختي جعفر

وعليكم السلام أخي وائل انت كتبت اسم BE بالخطأ ، وعدلت انا الشئ البسيط على البرنامج كذلك ، فاليك الكود المعدل: Private Sub Form_Close() On Error GoTo err_Form_Close 'make a backup of BE BE_or_FE = "C:\My Documents\Downloads\Officena.net\208.A" Backup_Folder = "C:\back_folder" 'Do a copy from a PC name jj ONLY If VBA.Environ("Computername") <> "wael" Then Exit Sub 'Delete the old saved accdb Kill Backup_Folder & "\AA_BE_*.accdb" 'Now lets work on saving the new accdb''Is this PC name = jj' ' BE_Address = BE_or_FE & "\AA_BE.accdb" BK_Address = Backup_Folder & "\AA_BE_" & Format(Now(), "yyyy-mm-dd_-hh-mm-ss") & ".accdb*" 'Debug.Print "xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34) Call Shell("xcopy " & Chr(34) & BE_Address & Chr(34) & " " & Chr(34) & BK_Address & Chr(34), vbHide) Exit Sub err_Form_Close: If Err.Number = 2450 Or Err.Number = 53 Then 'ignor Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub رجاء عدم تغيير الكود ، الإ السطرين التاليين فقط ، وهما لتحديد مسار BE ، وتحديد مسار back_folder جعفر 208.AA.mdb.zip

حيا الله أخوي رمهان مقارنة ملفات المجلد ، باسماء الملفات في السجلات ، هو الذي اخذ الكثير من الوقت ، ليس المقارنة نفسها ، وانما ماذا افعل اذا كان هناك ملف بدون سجل ، او سجل بدون ملف بالاضافة الى كيفية جعل البرنامج يشتغل بأقل تدخل من المستخدم وهنا (وبعد الغداء ) ساشرح البرنامج بطريقة مفصلة اكثر: عندما تختار المجلد ، فتلقائيا البرنامج سيأخذ اسم المجلد ومساره ، واسم الملفات الموجودة فيه ، ويضعها في النموذج الفرعي ، اذا كان هناك اسم في حقل مسار المجلد ، وضغطت على زر اختيار المجلد ، فسيطلب منك البرنامج تأكيد هذه العملية ، الكود يعمل على الحدث الحالي للنموذج الرئيسي ، فلا يحتاج الى تدخل من المستخدم ، في كل مرة تذهب الى سجل ، يعمل الكود على مقارنة معلومات المجلد بالمعلومات الموجودة في سجلات هذا الوارد ، السجل باللون الابيض معناه ان السجل والملف هما بنفس الاسم ، السجل باللون الازرق معناه ان هناك ملفات ولا توجد سجلات لهم ، لهذا السبب ، فالبرنامج استورد الاسماء ووضعها في السجل ، ولا تهتم باللون ، لأنك عندما تذهب الى سجل آخر ، ثم ترجع الى هذا السجل ، سترى ان الاسماء اصبحت بيضاء السجل باللون الاخر معناه انه لا يوجد ملف بهذا الاسم في المجلد ، وعليه تستطيع ان تحذفه ان شئت ، وعندما تضغط على طرف السجل وتضغط على زر الحذف ، فسيطلب منك البرنامج تأكيد الحذف ، البرنامج لا يحذف اي سجل تلقائيا. جعفر

وعليكم السلام أخي محمد أخي رمهان ، رحم الله والديك على السؤال عني السؤال ظاهرا سهل ، ولكنه ليس كذلك اللي عملته هو: 1. تغيير اسم النموذج الى frm_wared ، والنموذج الفرعي الى sfrm_emp_wared ، 2. في النموذج الرئيسي ، اضغط على زر المجلد ، وتستطيع اختيار المجلد الذي به الملفات: . 3. اضفت حقل جديد في الجدول للنموذج الفرعي ، اسمه File_Check ، ونستفيد منه في تلوين وتعريف السجل ، وعملناه مخفي: . 4. عملنا تنسيق شرطي لأحد الحقول (تستطيع ان تعمله لبقة الحقول ان احببت): . وهذان هما الشرطان فيه: . والالوان معناها: اللون الابيض: هناك ملف في المجلد بنفس الاسم ، اللون الاخضر: هذا السجل لا يوجد ملف بنفس اسمه ، اللون الازرق: هذا الملف موجود في المجلد وغير موجود في السجلات، . 5. وهذه نتيجة احد السجلات: . 6. وعندما تريد حذف السجل: . العمل على البرنامج اسهل من شرحه وهذا هو الكود كاملا: Option Compare Database Private Sub cmd_Open_Folder_Click() Dim strFolderName As String Dim strMsg As String If Len(Me.pate & "") <> 0 Then Dim Msg, Style, Response Msg = "مسار الملف موجود ، هل تريد تغيير المسار" & vbCrLf & _ "هل انت متاكد انك تريد الاستمرار في العملية" & vbCrLf & _ "Do you want to continue ?" Style = vbYesNo + vbCritical + vbDefaultButton2 Response = MsgBox(Msg, Style, Title, Help, Ctxt) If Response = vbYes Then strMsg = "رجار اختيار المجلد" & vbCrLf & _ "What Folder you want to select?" strFolderName = BrowseFolder(strMsg) If Len(strFolderName & "") <> 0 Then Me.pate = strFolderName Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1) End If End If Else strMsg = "رجار اختيار المجلد" & vbCrLf & _ "What Folder you want to select?" strFolderName = BrowseFolder(strMsg) If Len(strFolderName & "") <> 0 Then Me.pate = strFolderName Me.name_folder = Mid(Me.pate, InStrRev(Me.pate, "\") + 1) End If End If 'Len 'now bring the files from the folder Call Make_File_Array End Sub Function Make_File_Array() On Error GoTo err_Make_File_Array 'Folder info Dim File_Count As Integer Dim fdr As Variant Dim Files_Array() As Variant iPath_In = Me.pate iCondition = "*.*" 'No Path, exit If Len(iPath_In & "") = 0 Then Exit Function 'get the file count from the Forlder, and 'place the files in an array fdr = Dir(iPath_In & "\" & iCondition) File_Count = 0 Do While fdr <> "" File_Count = File_Count + 1 ReDim Preserve Files_Array(File_Count) Files_Array(File_Count) = fdr fdr = Dir Loop 'got the folder file count=File_Count, and the files=Files_Array(i) 'SubForm Records Dim rst As DAO.Recordset Set rst = Me.sfrm_emp_wared.Form.RecordsetClone rst.MoveLast: rst.MoveFirst RC = rst.RecordCount '1. Make all Records, File_Check=1 (No File) For j = 1 To RC rst.Edit rst!File_Check = 1 rst.Update rst.MoveNext Next j '2. Compare For i = 1 To UBound(Files_Array) 'File_Count iname_morfke = Files_Array(i) itayp = Mid(Files_Array(i), InStrRev(Files_Array(i), ".") + 1) rst.FindFirst "name_morfke='" & iname_morfke & "'" If rst.NoMatch Then 'No Match rst.AddNew rst!name_morfke = iname_morfke rst!tayp = itayp rst!File_Check = 2 rst!emp_id = Me.id_m rst.Update Else 'Matching 'but is it the same extension If rst!tayp = itayp Then 'Matching rst.Edit rst!File_Check = 0 rst.Update Else 'No Match rst.AddNew rst!name_morfke = iname_morfke rst!tayp = itayp rst!File_Check = 2 rst!emp_id = Me.id_m rst.Update End If End If Next i rst.Requery Exit Function err_Make_File_Array: If Err.Number = 3021 Then 'ignor, SubForm is empty Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Function Private Sub Form_Current() 'now bring the files from the folder Call Make_File_Array End Sub جعفر 207.1.m.salama.accdb.zip

وعليكم السلام أختي الخطأ هذا ليس بسبب ان نظام الكمبيوتر x64 ، وانما بسبب نظام الاوفيس 64bits. واذا اردتي ان تأخذي نصيحة مايكروسوفت ، فالنصيحة تقول بأن تنصبي اوفيس 32bits على جهازك ، بغض النظر اذا كان نظام الوندوز x64 اوx86 . ولأني لا املك نسخة الاوفيس 64bits ، فبعد البحث في الانترنت ، وجدت هذا الكود: #If VBA7 Then Private Declare PtrSafe Function CallNextHookEx Lib "user32" (ByVal hHook As LongPtr, _ ByVal ncode As Long, ByVal wParam As LongPtr, lParam As Any) As LongPtr Private Declare PtrSafe Function GetModuleHandle Lib "kernel32" Alias _ "GetModuleHandleA" (ByVal lpModuleName As String) As LongPtr Private Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As LongPtr, ByVal hmod As LongPtr, _ ByVal dwThreadId As Long) As LongPtr Private Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As LongPtr) As Long Private Declare PtrSafe Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As LongPtr, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As LongPtr, ByVal lParam As LongPtr) As LongPtr Private Declare PtrSafe Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hwnd As LongPtr, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long #Else Private Declare Function CallNextHookEx Lib "user32" (ByVal hHook As Long, _ ByVal ncode As Long, ByVal wParam As Long, lParam As Any) As Long Private Declare Function GetModuleHandle Lib "kernel32" Alias _ "GetModuleHandleA" (ByVal lpModuleName As String) As Long Private Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" _ (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, _ ByVal dwThreadId As Long) As Long Private Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long Private Declare Function SendDlgItemMessage Lib "user32" Alias "SendDlgItemMessageA" _ (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal wMsg As Long, _ ByVal wParam As Long, ByVal lParam As Long) As Long Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" _ (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long Private Declare Function GetCurrentThreadId Lib "kernel32" () As Long #End If '~~> Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 #If VBA7 Then Private hHook As LongPtr #Else Private hHook As Long #End If رجاء تجربته ، وافادتنا جعفر

وعليكم السلام أخوي الكريمين محمد ورمهان :-) فهمي للموضوع هو: - لديك مجلدات لكل كتاب أو وارد ، والكتاب الصادر أو الوارد قد يحتوي على مجموعة ملفات. س: ما إسم هذه المجلدات؟ أين توجد في الكمبيوتر؟ هل إسم المجلد له علاقة باي من حقول السجل؟ - تريد ان تفرز اسم وصيغة كل ملف موجود في المجلد الخاص للكتاب ، وهذه المعلومة تريدها في النموذج الفرعي. س: مثل ما قال الاخ رمهان ، مافي داعي لحفظ هذه الأسماء في الجدول. وفي احد مشاريعي ، طبقت طريقة قراءة محتوي المجلد في Listbox ، و عندما تريد فتح الملف ، تنقر مرتين على إسم الملف ، فيفتحه مباشرة من المجلد. هل ممكن استعمال هذه الطريقة ، أو أنك تريد الأسماء في الجدول لأنك تريد إضافة ملاحظات لكل ملف؟ س: شرحت لك أعلاه طريقة فتح الملف ، سواء بطريقتي أو بطريقتك في النموذج الفرعي. فلماذا تريد أن تحفظ الملف داخل قاعدة البيانات؟ حفظ الملفات داخل قاعدة البيانات غلط ، إلا في حدود جدا ضيقة ، وإلا فسيكبر حجم قاعدة بياناتك بطريقة مهولة ، وقد تصل إلى مرحلة العطب أو عدم إمكانية إضافة سجلات بها ، انا رأيت مثل هذه البرنامج :-( جعفر

وعليكم السلام أخي محمد :-) يا ريت توضح أكثر!! جعفر شو قصدك إحضارة لقاعدة البيانات؟ هل قصدك حفظه في قاعدة البيانات؟ و اذا جوابك كان نعم ، فالسؤال لماذا؟ جعفر

شكرا جزيلا على هذه المعلومة أخي الأستاذ محمد :-) جعفر

أخي عبدالله مشاكل Active x لها علاقة: بنسخة وتحديثات الويندوز ، نسخة وتحديث عنصر الـ Active x ، ولا علاقة لها بلغة الويندوز ، ولا لغة الاكسس. و عندما تريد أن تعمل برنامج لاستعماله على أي كمبيوتر ، فاستخدم نسخة الاكسس الانجليزية ، ولا تستخدم أي حروف unicode في عناصر الاكسس ولا في الكود. جعفر

أما انا ، فكنت اشتغل على مشروع قراءة ملف البصمة ، والمرتبط بحوالي 42 جهاز ، وكانت صيغة الجهاز هو dbf ، ولما لم يستطع الاكسس التفاهم معاه واخذ البيانات منه ، اشتريت dbf viewer من الرابط http://dbfviewer2000.com وعن طريق كود الاكسس ، وباستخدام هذا البرنامج ، يتم تحويل ملف dbf إلى csv وبالتالي اربطه بجداول الاكسس :-) والبرامج به طريقة تحويل عدة ملفات دفعة واحدة على ما اعتقد :-) جعفر

للاسف ، اكسس 2013 لا يتعامل مع dbf

تسلم أخوي محمد نتيجة عمل برامج مختلفة ، لفئات مختلفة ، على فترات مختلفة ، بلغات مختلفة ، لسنوات عدة ، يسمونها خبرة ولولا اسئلة الشباب ، لما طلعت هذه الخبرة للملأ فالشكر موصول لكم ، لأسئلتكم ومداخلاتكم جعفر

السلام عليكم وهذه النسخة الكاملة للموضوع (البارحة بعد ان كتبت كل شئ ، اتضح ان المنتدى اُغلق للصيانة ، وراح كل الشغل ) 2. عندما تستخدم البرنامج في شبكة بين مجموعة مستخدمين ، لا تريد البرنامج ان يعمل نسخة كلما خرج احد المستخدمين من البرنامج ، ولكن تريد ان يتم عمل النسخة عندما يخرج المستخدم الذي يعمل على الكمبيوتر jj فقط (طبعا يمكن استخدام اسم المستخدم بدلا من اسم الكمبيوتر): if vba.Environ ("Computername")<> "jj" then Exit Sub 3. السطر التالي يحذف جميع الملفات القديمة لهذا الملف: Kill Backup_Folder & "\Program\Haj_BE_*.accdb" Private Sub Form_Close() On Error GoTo err_Form_Close 'make a backup of BE BE_or_FE = "C:" Backup_Folder = "D:" 'Do a copy from a PC name jj ONLY if vba.Environ ("Computername")<> "jj" then Exit Sub 'Delete the old saved accdb Kill Backup_Folder & "\Program\Haj_BE_*.accdb" 'Now lets work on saving the new accdb''Is this PC name = jj' ' BE_Address = BE_or_FE & "\Haj_BE.accdb" BK_Address = Backup_Folder & "\Program\Haj_BE_" & Format(Now(), "yyyy-mm-dd_-hh-mm-ss") & ".accdb*" Call Shell("xcopy " & BE_Address & " " & BK_Address, vbHide) Exit Sub err_Form_Close: If Err.Number = 2450 or err.number=53 Then 'ignor Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر

وعليكم السلام أخي وائل اخذت لك هذا الكود من احد برامجي Private Sub Form_Close() On Error GoTo err_Form_Close 'make a backup of BE BE_or_FE = "C:" Backup_Folder = "D:" BE_Address = BE_or_FE & "\Haj_BE.accdb" BK_Address = Backup_Folder & "\Program\Haj_BE_" & Format(Now(), "yyyy-mm-dd_-hh-mm-ss") & ".accdb*" Call Shell("xcopy " & BE_Address & " " & BK_Address, vbHide) Exit Sub err_Form_Close: If Err.Number = 2450 Then 'ignor Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub وهذا الكود لنسخ الملف وليس لحذف القديم ، وفي هذا الرابط ستجد طريقة مشابهة لما تريد (اعذرني ، فوقتي لا يسمح لي بعمل المطلوب الان :( ) http://www.officena.net/ib/topic/61847-تعديل-على-كود-حفظ-مكان-الصورة/?do=findComment&comment=399928 جعفر

وعليكم السلام لا يوجد مشكلة الصيغة الجديدة للأكسس هي accdb ، وهي منذ الاصدار 2007 وفي اعتقادي اذا صار للأكسس صيغة جديدة ، فستحمل تاريخ الاصدار الجديد جعفر

يعني المشكلة اللي عندك الان هي: عندما تنتهي الطباعة ، يجب عليك اعادة ترتيب الاوراق؟ جعفر

وعليكم السلام أخي عبدالله ممكن نشتغل على الاعدادات حبة حبة ، لوسمحت اعطينا المشكلة ، وسنحاول حلها ، حبة حبة كلمة الاعدادات ، واللغة ، جدا كبيرة ، فلا يمكن اعطاء جواب واحد لها خلينا نشتغل كما يقول المثل: كيف تقدر تاكل فيل ، والجواب قطعة قطعة جعفر

كلامك صحيح وفي محله أخوي رمهان وعلشان يكتمل موضوع DAO و ADO ، فيجب الرجوع الى الرابط التالي كذلك: http://www.officena.net/ib/topic/62005-تصحيح-أخطاء-حسابات-الشجرة-بعد-الترقية-الى-2007-معدل/?do=findComment&comment=401138 جعفر

حياك الله عفوا ما فهمت قصدك!!

تفضل أخي اجعل التقرير من اليسار الى اليمين جعفر 203.New Microsoft Access Database.accdb.zip

السلام عليكم أخي عصام اسمح لي ان اتدخل مرة اخرى المعلومة التي انت طرحتها : Global is_db As DAO.Database لم اكن اعرفها ، لذلك ، وبعد توفر الكمبيوتر امامي ، والانترنت ، فقررت ان اجرب جميع الاحتمالات عملت برنامج وهو عبارة عن جدول وكود في نموذج لقراءة سجلات الجدول . 1. الطريقة الاولى لتفادي الخطأ: وكان اسم المشروع الافتراضي (كما ترى في الدائرة الحمراء) Database (وهذا ليس اسم قاعدة البيانات): . ولمعرفة مكان وجود اسم المشروع (كما اوضحت في مشاركاتي السابقة) ، VBA > Tools > Database Properties > General واتضح بان اسمه Database (لاحظ الدوائر الحمراء تشير الى اسم المشروع): . وعند استخدام كود مشابه للكود الذي استخدمته انت ، حصلت على نفس الخطأ الذي حصلت عليه انت: . فرجعت الى اسم المشروع ، وغيرته من Database الى Database1 K ، واشتغل الكود بدون اخطاء: . -------------------------------------------------------------------- وهنا اردت العمل على طريقتك ، فأرجعت اسم المشروع مرة اخى الى Database ، وعملت وحدة نمطية للكود الذي تفضلت به (ولكني استخدمك الكود الاصلي الذي كنت تستخدمه db بدلا عن is_db: . وشغلت الكود ، فحصلت على الخطأ مرة اخرى: . ثم غيرت db الى is_db ، وكذلك حصلت على الخطأ: . -------------------------------------------------------------------- 2. الطريقة الثانية لتفادي الخطأ: ارجعت اسم المشروع الى ما كان عليه Database ، ثم تأكدت ان المراجع لـ DAO و ADO موجودين في القائمة . وعليه ، لإستخدام نفس الكود الذي استعملته ، يكون كالتالي لـ DAO ، والذي لم احصل على خطأ عند استخدامه: . ولإستخدام نفس الكود الذي استعملته ، يكون كالتالي لـ ADO ، والذي لم احصل على خطأ عند استخدامه: . ياريت توضح لنا اكثر شوي عن طريقة استخدام الكود الذي استعملته ، والذي حل لك المشكلة ، لوسمحت جعفر

ولا يهمك أخوي رمهان ، اليك روابط بالصور :-) VBA > Tools > Database PROPERTIES انظر الصورة General Project name انظر الصورة سترى أن إسم المشروع هو Database ، غير اسم المشروع إلى أي إسم غير db ، ثم أنقر ok ، واحفظ قاعدة البيانات ، وجرب البرنامج الآن :-) مو سهل الرد على مثل هذه الأسئلة من الهاتف النقال :-) جعفر

عفوا مشاركتي محتاجه توضيح :-) بالنسبة للموظف ، فعند طلب إجازة ، يجب أن يعمل علامة صح في نموذج frm_Employee_see في الحقل Leave_Needs_Decission. عند وضع علامة الصح ، فطلب اجازته سيظهر للمسئول في النموذج frm_Management_See. عندها ، يجب على المسؤول أن يضع علامة صح في الحقل Management_Gave_Decission ، وعندما يضع علامة الصح ، فتظهر الاجازة للموظف المسؤول عن إنهاء إجراءات الاجازة ، في النموذج frm_Clark_See . وعندما تتم الاجراءات ، يجب عليه أن يضع علامة صح في الحقل Done حتى لا تظهر الاجازة في النموذج. و السبب الذي قلت يجب عمل حدث توقيت على On_Timer كل 5 دقائق مثلا لتحديث النموذج ، حتى لا يحتاج المسؤول وموظف الإجازات إلى إغلاق نماذجهم وفتحها لرؤية الطلبات الجديدة ، فالتحديث سيظهر على طول في النموذج المفتوح :-) جعفر

وعليكم السلام شباب :-) اسمحوا لي بالمشاركة :-) انا بعيد عن برنامج الاكسس ، فساحتاج مساعدتك قليلا :-) اذهب الى Tools ثم اختار (هنا محتاج مساعدتك) ، في احد الاختيارات ، سترى ان اسم قاعدة البيانات هو Database ، غيّره إلى jjafferr واضغط الزر موافق ، و كل شئ سيصبح تمام :-) طبعا تقدر تسميه أي اسم آخر ، و لكن لا تسميه db . جعفر