jjafferr

هل العمل الذي تقوم به هو لإثبات انه ممكن (Proof of Concept) 🙂 او حتى يستفيد منه الجميع ، المبتدئ والمحترف 😁 جعفر

السلام عليكم 🙂 واذا عندي معيار في استعلام النموذج ؟ جعفر

لا

وعليكم السلام 🙂 سؤالك هو: تظهر لك رسالة خطأ التالية: . ويكون المؤشر باللون الازرق في الكود على: . والحل هو: ان تعمل استبدال ctrl+h لجميع الكود : او تغيير اسم قاعدة بياناتك هنا ، الى اسم آخر غير عن Database او db او الاسماء المحجوزة للأكسس : . جعفر

وعليكم السلام 🙂 واهلا وسهلا بك في المنتدى 🙂 قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف 2. وطريقة البحث جدا سهلة ، وستحصل على ما تريد : . اكتب الكلمات اللي تريدها . وتظهر لك النتائج ، وكما في المثال اعلاه ، فهناك 16 صفحة من الروابط : . يُقفل. جعفر

السلام عليكم 🙂 1. رجاء انزل البرنامج المرفق ، ثم انسخ الكائنين منه الى برنامجك الرئيسي ، واحذف البرنامج المرفق ، ثم العمل على نسخة من برنامجك الاصلي ، 2. تأكد ان جميع النماذج مغلقه ، ثم افتح النموذج zfrm_Testing ، وانقر على الزر . 3. هذا سيعمل مجلدات في مجلد برنامجك ، وفي كل مجلد المرفقات التي به (حسب ID سجل برنامجك) ، وسيقوم بتصدير جميع مرفقاتك الى المجلدات : . 4. لما ينتهي البرنامج من تصدير الملفات ، سيعطيك رسالة Done ، 5. افتح النموذج Masttr Form2 ، وسترى المرفقات موجودة على يمين الشاشة (انظر للصورة في الاسفل) ، 6. المرفقات في الاعلى تابعة للنموذج الرئيسي ، والمرفقات في الاسفل تابعة للنموذج الفرعي (رجاء التاكد ان المرفقات صحيحة ، وهي نفسها الموجودة في برنامجك) : . انا لم اقم بعمل كود لحذف اي شيء من برنامجك ، اذا اردت ان تضيف مرفق جديد ، فتستطيع ان تمسكه من متصفح الملفات ، وتفلته Drag and Drop سواء في المجلد العلوي او السفلي ، البرنامج تلقائيا يضيف المجلدات. بعد ان تتأكد ان البرنامج يعمل بطريقة صحيحة ، تستطيع يدويا ان تحذف حقول المرفقات من جدوليك ، ثم استعمل ضغط واصلاح 🙂 هذا هو الكود الموجود في النموذج zfrm_Testing ، والذي يصدر المرفقات الى مجلدات و ملفات خارجية : Private Sub cmd_Export_Attachments_Click() On Error GoTo err_cmd_Export_Attachments_Click Dim rst_tbl As DAO.Recordset Dim rst_Att As DAO.Recordset Dim myDir As String Dim File_Name As String 'table name : [Mastr Table] 'Attachment filed name : [مرفقات] Set rst_tbl = CurrentDb.OpenRecordset("Select * From [Mastr Table]") While Not rst_tbl.EOF ' Loop through the table 'check if the Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Make_Dir(myDir) myDir = myDir & "\Mastr_Table" 'Mastr_Table Call Make_Dir(myDir) ' myDir = myDir & "\" & rst_tbl![CUSTOMER COD] 'Customer_Code ' Call Make_Dir(myDir) myDir = myDir & "\" & rst_tbl!ID 'ID Call Make_Dir(myDir) Set rst_Att = rst_tbl.Fields("[مرفقات]").Value While Not rst_Att.EOF ' Loop through the attachments. ' File_Name = myDir & "\" & rst_tbl!ID & "_" & rst_Att.Fields("Filename") 'ID and Attachment names ' rst_Att.Fields("FileData").SaveToFile File_Name ' Save current attachment rst_Att.Fields("FileData").SaveToFile myDir rst_Att.MoveNext Wend 'rst_Att rst_tbl.MoveNext Wend 'rst_tbl '' ' '[Payment Table] '[مرفقات] Set rst_tbl = CurrentDb.OpenRecordset("Select * From [Payment Table]") While Not rst_tbl.EOF ' Loop through the table 'check if the Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Make_Dir(myDir) myDir = myDir & "\Payment_Table" 'Mastr_Table Call Make_Dir(myDir) ' myDir = myDir & "\" & rst_tbl![CUSTOMER COD] 'Customer_Code ' Call Make_Dir(myDir) myDir = myDir & "\" & rst_tbl!ID 'ID Call Make_Dir(myDir) Set rst_Att = rst_tbl.Fields("[مرفقات]").Value While Not rst_Att.EOF ' Loop through the attachments. ' File_Name = myDir & "\" & rst_tbl!ID & "_" & rst_Att.Fields("Filename") 'ID and Attachment names ' rst_Att.Fields("FileData").SaveToFile File_Name ' Save current attachment rst_Att.Fields("FileData").SaveToFile myDir rst_Att.MoveNext Wend 'rst_Att rst_tbl.MoveNext Wend 'rst_tbl rst_tbl.Close: Set rst_tbl = Nothing rst_Att.Close: Set rst_Att = Nothing Exit_cmd_Export_Attachments_Click: MsgBox "Done" Exit Sub err_cmd_Export_Attachments_Click: If Err.Number = 3420 Then 'ignore rst not there Resume Next ElseIf Err.Number = 3839 Then 'file exists Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub Public Function Make_Dir(Dir_Name As String) As Boolean 'Make_Dir = True ' a new Directory was made 'Make_Dir = False ' the Directory Exists 'check if the Dir exists, if not, make it If Dir(Dir_Name, vbDirectory) = "" Then MkDir Dir_Name Make_Dir = True ' a new Directory was made End If End Function . وهذا كود لحدث الحالي والذي يُظهر المرفقات في كائن webbrowser في النموذج Masttr Form2 : Dim myDir As String 'Mastr_Table, Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\Mastr_Table" 'Mastr_Table Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\" & Me!ID 'ID Call Form_zfrm_Testing.Make_Dir(myDir) 'Payment_Table, Dir exists, if not, make it myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\Payment_Table" 'Payment_Table Call Form_zfrm_Testing.Make_Dir(myDir) myDir = myDir & "\" & Me!ID 'ID Call Form_zfrm_Testing.Make_Dir(myDir) 'specify that the browser is an object in the Form Set web = Me.objIE.Object Set web_2 = Me.objIE_2.Object 'Master, Open/Navigate the page myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments myDir = myDir & "\Mastr_Table" 'Mastr_Table myDir = myDir & "\" & Me!ID web.Navigate myDir 'Payment, Open/Navigate the page myDir = Application.CurrentProject.Path & "\Attachments" 'Attachments myDir = myDir & "\Payment_Table" 'Mastr_Table myDir = myDir & "\" & Me!ID web_2.Navigate myDir جعفر 1195.zip

ولكني اريد ان ارجع الى مقترحي السابق : واليك التفاصيل من واقع تجربتي مع اطباء الاسنان ، وكلامنا عند النقر المزدوج على الضرس ، وبها يتم ادراج سجل جديد في النموذج الفرعي : 1. سيكون لديك سجل عن رقم الضرس التي تم قلعها ، ومتى وملاحظات الدكتور ، 2. بالنسبة الى حشو الضرس (والذي هو محل نقاشنا) ، ومن تجربتي ، وبعد 5 الى 10 سنوات ، يأتي الشخص الى الدكتور وفيه وجع ، ويقوم الدكتور بالفحص ويسأل : اي ضرس تم العمل عليه سابقا ، متى تم العمل عليه ، ماهي الخطوات التي قام الدكتور بعملها (هل اكمل العمل في جلسة واحدة لسبب معين ، او اكثر من جلسة ، وماذا عمل في كل جلسة) ، من الدكتور الذي قام بالعمل ، وهل هناك ملاحظات خاصة تركها الدكتور لهذا الضرس ، هل تم ازالة العصب ، هل تم عمل حشو مؤقت من نوع معين ، على ان يرجع الشخص بعد وقت معين لجلسة اخرى لعمل حشو من نوع آخر ، متى تم تنضيف الاسنان . هذه بعض الملاحظات اللي تجي على بالي ، وبرنامجك لا يقوم بها ، بينما اذا عملت البرنامج مثل اقتراحي ، فيمكنك اضافة جميع هذه الملاحظات في النموذج الفرعي (وهو جاهز بنسبة 70-80%) ، وحذف الـ 54 كائن من Option Group والتي تزيد من ثقل النموذج !! مجرد إضافة حقل "نوع العمل" كومبوبكس ، واسم الدكتور ، والسلام 🙂 طبعا الكود سيقوم بإظهار وإخفار الضروس ، حسب "نوع العمل" 🙂 ومثل ما قلت لك سابقا : . جعفر

تفضل اخي jo 🙂 بدلا عن For i = 1 To RC Select Case rst!Tooth_Number Case 11 To 48 Me("A_" & rst!Tooth_Number).Visible = False Case 51 To 85 Me("P_" & rst!Tooth_Number).Visible = False End Select rst.MoveNext Next i استعمل For i = 1 To RC Select Case rst!Tooth_Number Case 11 To 48 Me("A_" & rst!Tooth_Number).Visible = False Me("s" & rst!Tooth_Number).Visible = False Case 51 To 85 Me("P_" & rst!Tooth_Number).Visible = False Me("s" & rst!Tooth_Number).Visible = False End Select rst.MoveNext Next i . جعفر

وعليكم السلام 🙂 1. انت محتاج الى هذا الكود لنسخ المرفقات من قاعدة البيانات الى مجلد في الكمبيوتر : ' 'from 'https://docs.microsoft.com/en-us/office/vba/access/Concepts/Data-Access-Objects/work-with-attachments-in-dao ' ' Instantiate the parent recordset. Set rsEmployees = db.OpenRecordset("Employees") 'Code to move to desired employee ' Instantiate the child recordset. Set rsPictures = rsEmployees.Fields("Pictures").Value ' Loop through the attachments. While Not rsPictures.EOF ' Save current attachment to disk in the "My Documents" folder. rsPictures.Fields("FileData").SaveToFile _ "C:\Documents and Settings\Username\My Documents" rsPictures.MoveNext Wend 2. حذف حقول الرفقات من برنامجك ، 3. اذا عندك اكثر من مرفق لنفس السجل ، فالافضل ان تعرض اسماء المرفقات في النموذج ، والمستخدم ينقر على الصورة اللي يريده ، ويشوفها في النموذج : . جعفر

وعليكم السلام 🙂 قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة و بصفة خاصة نؤكدعلى ما يلي 1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة 2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد. 3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال. 4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا..... 5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم. ومخالفة ذلك تعرض الموضوع للحذف 2. وطريقة البحث جدا سهلة ، وستحصل على ما تريد : . . والنتائج 16 صفحة من الروابط : . 5. رجاء لا تقوم بعمل نفس الموضوع مرة بعد اخرى ، وانما ، فقط اكتب في الموضوع : للرفع (مثلا) ، حتى يرتفع الموضوع مرة اخرى على القئمة في الصفحة الرئيسية 🙂 جعفر

السلام عليكم 🙂 نقدر نعمل ملف XML ونضيف فيه القائمة PlayList ، ونحفظ بصيغة wpl Private Sub Make_List_2() On Error Resume Next ' 'from 'http://www.vbforums.com/showthread.php?871083-playlist-in-vb6&p=5357495&viewfull=1#post5357495 ' Dim i As Integer 'delete the file, if exists Kill Application.CurrentProject.Path & "\PlayListTest.wpl" 'Create and save a playList Open Application.CurrentProject.Path & "\PlayListTest.wpl" For Output As #1 Print #1, "<?wpl version="; 1#; "?>" Print #1, "<smil>" Print #1, " <head>" Print #1, " <title>PlaylistTest</title>" Print #1, " </head>" Print #1, " <body>" Print #1, " <seq>" For i = 0 To Me.PlayList.ListCount - 1 Print #1, " <media src=" & Chr(34) & Me.PlayList.Column(0, i) & Chr(34) & "/>" Next i Print #1, " </seq>" Print #1, " </body>" Print #1, "</smil>" Close #1 End Sub . ثم نناديه هكذا : 'do the XML playlist Call Make_List_2 With Me![wmp] .URL = Application.CurrentProject.Path & "\PlayListTest.wpl" End With . ولكنه لا يقرأ الملفات بالاحرف العربية !! فقد تستطيع ان تستعمل الكود من برنامجك الذي يحول الكلمات العربية الى chrW 🙂 جعفر 1194.Digital Player.zip

اخي كرار 🙂 لماذا تنقر على "ابلغ فريق الموقع عن مخالفة" ؟ هل هناك مخالفة ؟ رسالتك هناك تذهب الى الادارة ، ولا يراها صاحب الموضوع. اذا كان قصدك ان توضع رد للموضوع ، فالرد من يكون من اسفل الموضوع ، في المكان المكتوب عليه "اضف رد على هذا الموضوع ، وهذا شكله: جعفر

هممم الظاهر المطلوب بين شغلك اخوي ابوخليل ، و كود في هذا الرابط : . حيث قلت: . جعفر

وعليكم السلام 🙂 استاذ كرار ، انت لم تشرح المطلوب !! رجاء الشرح بأكبر كمية من المعلومات ، وبأمثلة 🙂 واخونا @ابوخليل كان مشارك في الموضوع السابق 🙂 جعفر

كذلك اعتذر منك ، اعطيتك امر اول حرف ، ونسيت الباقي !! [m_name] = Replace(Mid([m_name],1,1), "أ", "ا") & Mid([m_name],2) او [m_name] = Replace(left([m_name],1), "أ", "ا") & Mid([m_name],2) جعفر

اذا بكره الله سبحانه وتعالى اعطانا عمر ، فأشوف الموضوع ان شاء الله 🙂 جعفر

جرب ShellWait (ولكن استعمل النسخة اللي استعملناها في برنامج QR https://www.officena.net/ib/topic/90906-كارنيهات-باستخدام-باركود-ماتركس-qr-code/ )

وعليكم السلام باشمهندس 🙂 لك وحشه يا راجل 🙂 الامر ShellWait يعمل تماما مثل Shell ، فقط تغير اسم الامر ، وخلاص 🙂 جعفر

وعليكم السلام 🙂 اللي تريده اسمه تنسيق شرطي ، وهذه الروابط تفيدك . . . . . جعفر

العفو [m_name] = Replace(Mid([m_name],1,1), "أ", "ا") او [m_name] = Replace(left([m_name],1), "أ", "ا") جعفر

حياك الله اخوي سلمان 🙂 وشكرا على سعة صدرك وتجاربك 🙂 جعفر

همممم اعتذر منك اخي حسين ، فانا وكما اخبرتك : .لازم تشوف ملف SDK الجهاز ، او ملف التحكم او اوامر الجهاز ، وبعدين ممكن نخطو للخطوة التالية 🙂 جعفر

همممم احنا نتكلم عن موضوعين مختلفين !! انا قلت اجعل المستخدم يضغط على الزر اللي على جهاز السكانر : . بينما انت تريد : . وانا رديت عليك مسبقا وقلت : جعفر

رحم الله والديك دنيا وآخرة ، و زاد الله فضله عليك 🙂 في هذه الحالة ، بالاضافة الى مشاركتي السابقة مع المرفق ، عندك طريقة اخرى ، وبدون الوحدة النمطية الثانية : Public Function Make_File() Dim BE_Path, PauseTime, Start 'get the server path BE_Path = DLookup("[Database]", "MSysObjects", "[Database] Is Not Null") 'Path and BE name BE_Path = Mid(BE_Path, 1, InStrRev(BE_Path, "\")) BE_Path = BE_Path & "dummy.txt" 'make the dummy txt file Open BE_Path For Output As #1 Print #1, "No text required" Close #1 'pasue for a second, until file is recognized, for slow networks PauseTime = 1 ' Set duration. Start = Timer ' Set start time. Do While Timer < Start + PauseTime DoEvents ' Yield to other processes. Loop 'get the date created Make_File = FileDateTime(BE_Path) 'clean up, delete the file Kill BE_Path End Function جعفر

جرب هذا الكود : [m_name] = Replace(left([m_name],1,1), "أ", "ا") جعفر