نجوم المشاركات

السلام عليكم ورحمة الله وبركاته ***** لا تستخدم هاتفك الشخصي ، فالبرنامج سيحذف جميع الصور التي في المجلد sdcard/DCIM/Camera ***** هذا جزء رقم 1 من مشروع متكامل لتصوير الاشخاص والمستندات بإستخدام الكاميرات والماسح الضوئي (Scanner) ، والمشروع يتكون من: يعني مو بس البرامج الكبيرة تستخدم هذه التقنيات ، وإحنا بعد وهذه الاجهزة ستكون لتصوير الاشخاص والمستندات ، ان شاء الله التصوير عن طريق كاميرا هاتف اندرويد ، وتمت التجربة على هاتف اندرويد Galaxy S3 بنظام 4.4 و Huawei Mate 7 بنظام اندرويد 6 ، التصوير عن طريق WebCam ، وتمت التجربة على Logitec HD c615 ، التصوير عن طريق الكامرات الكبيرة من نوع DSLR ، وتمت التجربة على Nikon D5100 او Canon Mark iii ، تطويع الماسح الضوئي لتصوير المستند/المستندات ، وحفظ المستندات الى اي مجلد ، بصيغة pdf او jpg العمل غير مكتمل 100% ، والخطوات التي على قائمة العمل: 1. إعطاء المستخدم الآلية لتحديد مكان قطع الصورة (لمرة واحدة طبعا) ، وحذف الزوائد ، مثلا: الخلفية الثابته: . تصوير الشخص . قطع الصورة وحذف الزوائد (برمجيا) . وكذلك يمكن الاستفادة منه في تصوير مستندات A4 او A5 ، وقطع الصورة وحذف الزوائد (طبعا يكون هناك زر للـ A4 وزر آخر للـ A5) 2. ماذا لو اردت حفظ صورة / مستند ، وكانت هناك صورة سابقا بنفس الاسم؟ سيكون للمستخدم 3 اختيارات: أ- احذف الصورة القديمة واستبدلها بالصورة الجديدة ، ب- اعطي الصورة الجديدة الرقم التسلسلي التالي ، حسب آخر رقم موجود للصورة ، مثلا: الصورة الموجودة سابقا 1.jpg او Inward_2017_05_06.jpg والصورة الجديدة ستصبح 1_001.jpg او Inward_2017_05_06_001.jpg هذه العملية تنفع للأرشفة ج- دائما اجعل الصورة الجديدة بدون ترتيب ، واجعل الصورة السابقة تأخذ آخر رقم ، مثلا الصورة الموجودة سابقا 1.jpg او Inward_2017_05_06.jpg وآخر صورة في المجلد لنفس الصورة هي 1_001.jpg او Inward_2017_05_06_001.jpg عليه سنأخذ آخر صورة موجودة في المجلد ونعطيها الرقم التسلسلي التالي 1_002.jpg او Inward_2017_05_06_002.jpg والصورة الجديدة التي سنلتقطها ستكون 1.jpg او Inward_2017_05_06.jpg هذه العملية تنفع لبرامجنا والتي تستعمل اسم الصورة ، والذي يكون رقم الموظف مثلا وبقية الصور تسلسلها حسب القِدم . 3- حفظ الصور افقيا او عموديا. والآن الى برنامجنا التصوير عن طريق كاميرا هاتف اندرويد اولا: تهيئة الهاتف (البرنامج المرفق فيه المادة رقم2 ، ولا يوجد داعي لإنزاله) : رجاء اتباع الخطوات التالية ليكون الهاتف مهيأ للإتصال بالبرنامج ، ويجب ان يكون الهاتف موصل بالكمبيوتر عن طريق USB: 1- يجب ان يكون الكمبيوتر متعرف على هاتفك ، ويمكنك انزال هذا التعريف من شركة هاتفك ، او من الرابط التالي ، رقم 1 : http://adbshell.com/downloads . وبرنامجنا محتاج الى البرنامج الذي في الرابط اعلاه ، رقم 2 ، والذي لا يحتاج الى تنصيب (ونضع محتواه في المجلد Android_Mobile كما في الصور في الاسفل) ، او اذا اردت البرنامج اعلاه من مصدر آخر وبه SDK الاندرويد (اي جميع برامج التحكم في جزئياته) ، فيمكن تنزيله من الرابط: https://dl.google.com/android/repository/platform-tools-latest-windows.zip 2- يجب ان يكون هاتفك في وضع Developer Options ، كما في الصورة: . واذا لم يكن ، فعليك اتباع الخطوات التالية لعمله : من الاعدادات . وسترى . ثم انقر على المربع الاحمر ، ليأخذك الى الصورة التاليه ، واختار المربعين بعلامة صح . وعند ربط الهاتف بالكمبيوتر ، اختار من الهاتف . وعند تشغيل البرنامج ، سيطلب منك الهاتف الموافقه على السماح بالكمبيوتر التحكم فيه ، فاختار السماح ، 1 ثم 2 . الآن هاتفك مهيأ للتحكم فيه من خلال البرنامج ، ورجاء اجعل الهاتف في وضع الاغلاق (حيث تكون الشاشة سوداء) ، 3- مجلد برنامجك يجب ان يكون بهذه الطريقة . البرنامج مفتوح المصدر ، وتحتاج لمسك مفتاح Shift عند النقر المزدوج على ايقونة البرنامج لفتحه ورؤية الكود ، - البرنامج يفتح على النموذج frm_Main حيث تختار اسم الشخص او رقمه ، . وعند النقر على تفاصيل الموظف او تفاصيل الموظفين ، يفتح النموذج frm_Names ، وتلقائيا سترى ان الهاتف اشتغل ، وعند الخروج من النموذج سوف يغلق الهاتف ، في النموذج frm_Names ، عند النقر على هذه الايقونة سيتم التصوير . وخلال 8-9 ثوان ، سترى الصورة داخل النموذج ، ان شاء الله ويمكنك جعل الهاتف يأخذ الصورة بالفلاش ، من اعدادات الهاتف نفسه ، هذا كود البرنامج بطريقين ، الطريقة الاولى والتي تأخذ الوقت الاقل ، وتركت الطريقة الثانيه الابسط هنا كذلك للذي يريد اللعب فيه وتغييره: Private Sub Form_Load() Call BE_or_FE 'Adb location App_Location = BE_Path & "Camera_App\Android_Mobile\Adb.exe" 'turn on the Device cmmd = " shell input keyevent KEYCODE_POWER" Call Shell(App_Location & cmmd, vbHidden) End Sub Private Sub Form_Close() Call BE_or_FE 'Adb location App_Location = BE_Path & "Camera_App\Android_Mobile\Adb.exe" 'turn off the Device cmmd = " shell input keyevent KEYCODE_POWER" Call Shell(App_Location & cmmd, vbHidden) End Sub Private Sub cmd_Android_Camera_Click() On Error GoTo err_cmd_Android_Camera_Click 'KEYCODE_POWER = 26 'KEYCODE_CAMERA = 27 'KEYCODE_BACK = 4 'KEYCODE_HOME = 3 Dim cmmd As String 'how long does it take to take the picture istart = Timer 'set BE_Path Call BE_or_FE 'Adb location App_Location = BE_Path & "Camera_App\Android_Mobile\Adb.exe" Save_images_to = BE_Path & "images\" 'image capture mode cmmd1 = App_Location & " shell " & Chr(34) & "am start -a android.media.action.STILL_IMAGE_CAMERA" & "; sleep 1; " cmmd2 = "input keyevent KEYCODE_CAMERA" & "; sleep 2; " cmmd3 = "input keyevent KEYCODE_BACK" & ";" & Chr(34) cmmd = cmmd1 & cmmd2 & cmmd3 'Debug.Print cmmd Call ShellWait(cmmd, vbHidden) 'transfer the image to the PC cmmd = App_Location & " pull /sdcard/DCIM/Camera/ " & Save_images_to & "temp\" Call Shell(cmmd, vbHidden) 'Delete the pictures from the mobile camera folder cmmd = App_Location & " shell rm /sdcard/DCIM/Camera/*.jpg" Call Shell(cmmd, vbHidden) PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'Delete the existing Employee_ID Kill Save_images_to & Me.Employee_ID & ".jpg" 'move the picture from folder temp and change its name Dim StrFile As String StrFile = Dir(Save_images_to & "temp\") Do While Len(StrFile) > 0 Mobile_Pic = StrFile StrFile = Dir Loop Name Save_images_to & "temp\" & Mobile_Pic As Save_images_to & Me.Employee_ID & ".jpg" PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'show the picture in the Form Me.Pic.Picture = Save_images_to & Me.Employee_ID & ".jpg" 'Delete the temp folder RmDir Save_images_to & "temp\" 'MsgBox Timer - istart Exit Sub to_Here: 'image capture mode cmmd = " shell " & Chr(34) & "am start -a android.media.action.STILL_IMAGE_CAMERA" & Chr(34) Call ShellWait(App_Location & cmmd, vbHidden) 'Dim PauseTime, Start PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'take a picture cmmd = " shell " & Chr(34) & "input keyevent KEYCODE_CAMERA" & Chr(34) Call ShellWait(App_Location & cmmd, vbHidden) PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'exit the image capture mod cmmd = " shell " & Chr(34) & "input keyevent KEYCODE_BACK" & Chr(34) Call ShellWait(App_Location & cmmd, vbHidden) Call ShellWait(App_Location & cmmd, vbHidden) PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'transfer the image to then PC cmmd = " pull /sdcard/DCIM/Camera/ " & Save_images_to & "\temp" Call ShellWait(App_Location & cmmd, vbHidden) PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'Delete the image from the camera cmmd = " shell rm /sdcard/DCIM/Camera/*.jpg" Call Shell(App_Location & cmmd, vbHidden) PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'Delete the existing Employee_ID Kill Save_images_to & Me.Employee_ID & ".jpg" 'move the picture from folder temp and change its name 'Dim StrFile As String StrFile = Dir(Save_images_to & "temp\") Do While Len(StrFile) > 0 Mobile_Pic = StrFile StrFile = Dir Loop Name Save_images_to & "temp\" & Mobile_Pic As Save_images_to & Me.Employee_ID & ".jpg" PauseTime = 1 Start = Timer Do While Timer < Start + PauseTime DoEvents Loop 'Delete the temp folder RmDir Save_images_to & "temp\" 'show the picture in the Form Me.Pic.Picture = Save_images_to & Me.Employee_ID & ".jpg" 'MsgBox Timer - istart Exit_cmd_Android_Camera_Click: Exit Sub err_cmd_Android_Camera_Click: If Err.Number = 53 Then 'No picture to delete Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub والبرنامج حاليا للمتطوعين الذين يعرفون ان البرنامج لا يحتوي على اي ميزات غير التصوير وحفظ الصور في المجلد Images ، وربط الصور برقم الموظف ورجاء اخبرونا عن نتائج تجربتكم وملاحظة هامة: ***** لا تستخدم هاتفك الشخصي ، فالبرنامج سيحذف جميع الصور التي في المجلد sdcard/DCIM/Camera ***** جعفر Camera_Scanner.zip

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

نعم مطلوبين للمهام الخاصة للتجربة والتطبيق وفيه ناس تم الاعلان عن أسمائهم

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

حياك الله أخوي عبدالله في اعدادات النموذج ، آخر اعداد ، Key Preview ، اجعله نعم . جعفر

وعليكم السلام أخي عبدالله هاي الكود من VBA Help مباشرة ، الظاهر معمول ومفصّل لك Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) ' The Keycode value represents the key that ' triggered the event. Select Case KeyCode ' Check for the PAGE UP and PAGE DOWN keys. Case 33, 34 ' Cancel the keystroke. KeyCode = 0 End Select End Sub جعفر

بعد إذن حبيبنا الغالي أبا البراء وعلى نفس طريقة الكود السابق فقط يمكن تعديله إلى Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 7 Then If Target.Column >= 89 And Target.Column <= 100 Then Application.EnableEvents = False Cells(Target.Row, "CT").Value = "" Cells(Target.Row, "CT").Value = Cells(Target.Row, "CV").Value - Int(Cells(Target.Row, "CV").Value) Application.EnableEvents = True End If End If End Sub وفقنا الله جميعا لكل ما يحب ويرضى

لإثراء الموضوع وكما طلب الأخ صاحب السؤال الأستاذ كعبلاوي هذه صورة توضح الخطوات بدقة في أوفيس 2003 وما قبله بداية من إظهار شريط الأدوات forms بالضغط كلك يمين RC على أي شريط أدوات وفقنا الله وإياكم لكل ما يحب ويرضى

بالهناء والشفاء - كان ودى أشاركك القهوة ولكنها تسبب لى الأرق - ليس بالجديد علينا أبداعاتكم أستاذى الحبيب جعفر - ولكن ما الداعى للمتطوعين هما مطلوبين بالجيش ولا ايه . بارك الله فيك. استاذنا جعفر وجزاك الله خيرا

::: تفضل أرجو أن يكون طلبك .. SrcObj_up.rar

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

رائعة النابغه ياسر خليل في الترحيل بالمصفوفات ترحيل أعمدة غير متجاورة لأعمدة غير متجاورة باستخدام المصفوفات (كود حصري) https://youtu.be/ndC28IqkkBw ** من يريد دعمي فليقم بالاشتراك في القناة وعمل لايك للفيديوهات ============= رابط الملف https://www.file-upload.com/ablfo2nqpekx

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

الان انا اعمل علبرامج وزبائني يريده مني ان اعمل لها باقصر وقت ممكن وبع ذلك ان شاء الله راح اكتب اسمي مع المتطوعين

لا لا كدا اتفهم كلامى خطأ كنت أقصد لن يضيف المتطوعين شيئا سوى الاطراء فالعمل يبدو عليه أثر الجهد المبذول وكما قلت ثم صحيح نحن زبائن مجانا - ولكن نسأل الله أن يعظم لكم الأجر عنا لا لم يكن ما تبذلونه بدون نتيجة أبدا - والله ما أذكر برنامجا صنعته إلا واقتبست فيه من عطاياكم شيئا , طبعا بدون استأذان - وها أنا أنتهز الفرصة لأستأذن منكم فى ذلك . وعلى كل ورغم أن اسمى لم أجده فى المعلن عنهم الا أنى سأجرب وأوافيكم بالنتائج إن شاء الله. مع إنى عارف النتيجة مسبقا 100 %

أخى الفاضل الاستاذ / سليم حاصبيا أخى الفاضل الاستاذ / محمد صالح أخى الفاضل الاستاذ / ياسر خليل السلام عليكم ورحمته الله وبركاته جزاكم الله خيرا وبارك فيكم جميعا على هذة المشاركات القيمة بقيمة أخلاقكم الكريمة فجميعها والحمد لله تعالى أدىت الغرض منها على إختلاف أفكارها شاكر فضلكم جميعا **** وجزاكم الله خيرا

جرب الكود التالي Sub Test() Dim sh As Worksheet, i As Long, rng As Range, y, z 'اسم ورقة العمل Set sh = Sheets("Sheet1") Application.ScreenUpdating = False 'مسح النطاق المطلوب وضع النتائج فيه sh.Range("CT8:CT100").ClearContents 'حلقة تكرارية من الصف رقم 8 إلى الصف رقم 100 For i = 8 To 100 'تعيين نطاق لعمود الصافي Set rng = sh.Range("CV" & i) If rng.Value = "" Then rng.Offset(0, -2).Value = "" Else y = Application.WorksheetFunction.Floor(rng.Value, 1) z = Application.WorksheetFunction.Round((rng.Value - y), 2) If z = 0 Then z = "" rng.Offset(0, -2).Value = z End If Next i Application.ScreenUpdating = True End Sub والأفضل وضعه في كود وتنفيذه مرة واحدة فقط .. أفضل من التعامل مع التغير في حدث ورقة العمل إذا أردت التغير في ورقة العمل حاول تدرس الكود وتطبقه بنفسك .. للتدريب (أما أنا لا أحبذ التعامل مع التغير في ورقة العمل في هذه الحالة ، حيث لا داعي لذلك)

ممممممم موضوع متطور عن الذي عهدناه .. يحتاج الى تفحيص وتمحيص وتحليل وتجريب وتخريب وتركيب وتركيز للوصل الى نتيجة ما .. لكن مالفت نظري هو لماذا "***** لا تستخدم هاتفك الشخصي ، فالبرنامج سيحذف جميع الصور التي في المجلد sdcard/DCIM/Camera *****" أليس من الافضل جعله لايحذف اي شيء الا بامر من المستخدم ؟ على العموم .. انا لا املك تليفون للتجربة ... ارجو من الاخوة الافاضل مشاركتنا التجربة تحياتي

تعطي الخطا الاصفر الاتــي =========== جزاك الله خيرا استاذ ياسر للهم في هذا اليوم المبارك اجعله لأعز الـــناس عندي يوما مبـــــــــــــــــــــــاركا فيه الدعوة لا تــــــــــــــرد وهبه رزقا لا يعـــــــــــــــد وافتح له باب في الجنة لا يسد واحشره في زمرة سيدنا محمد صلى الله عليه وسلم

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

وعليكم السلام تفضل ، هذا الرابط فيه شرح ومرفق لمثل طلبك: ولأنك تستخدم نموذج فرعي ، فرجاء استعمال هذا الكود بدل الذي في المرفق: Public Sub MoveScroll(n As Long) On Error GoTo err_MoveScroll Dim distance As Long Dim frm As Form 'Setting Constant Description '0 acDetail Form detail section '1 acHeader Form header section '2 acFooter Form footer section '3 acPageHeader Form page header '4 acPageFooter Form page footer Set frm = Forms!Form1!Form2.Form Form_Title_Bar_Height = 405 Form_Navegation_Bar_Height = 405 Form_Header = frm.Section(acHeader).Height Form_Footer = frm.Section(acFooter).Height Form_Page_Header = frm.Section(acPageHeader).Height Form_Page_Footer = Me.Form.Section(acPageFooter).Height Form_Sections = Form_Header + Form_Footer + Form_Page_Header + Form_Page_Footer distance = (n * (frm.WindowHeight - Form_Sections - (Form_Title_Bar_Height + Form_Navegation_Bar_Height))) Forms!Form1.Form2.SetFocus DoCmd.GoToPage 1, , distance Exit Sub err_MoveScroll: If Err.Number = 2462 Then 'ignore, section not available Resume Next Else MsgBox Err.Number & vbCrLf & Err.Description End If End Sub جعفر

السلام عليكم شباب هل لاحظ احدكم شيء في الصورة اللي ارفقتها ، شيء للمستقبل وشغّال عندي 100% جعفر

يالله يا شباب ، الخطوة الاولى متاحة للجميع ، اكسس 2003 فما فوق ، من هنا جعفر

ولك اخي الحبيب واستاذنا الفاضل بمثل ما دعوت ، والحمد الله ان انقضت حاجتك

جارى العمل عليه يأخى صبرك بالله افادك استاذنا الجليل أبوخليل وعلى حسب فهمى الشخصى ارفقت لك مثال بطريقة مختلفة بعد اذن استاذى ابوخليل أولا أنشأت لك زر جديد اسمه start فى النموذج الرئيسى عند الضغط عليه فى حالة ان حقل الخانة فارغ يقوم بكتابة تم ويأخذ من خانة اخر تاريخ فى الرئيسى بالتوفيق amr.rar

هذا التعديل حسب ما فهمت منك test121.rar

وعليكم السلام إذا كان الأمر يخص المسح أضف سطر يقوم بمسح الخلية الهدف والسطر كفيل بإنهاء المشكلة Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 7 Then If Target.Column >= 30 And Target.Column <= 49 Then Application.EnableEvents = False Cells(Target.Row, "AN").Value = "" Cells(Target.Row, "AN").Value = Cells(Target.Row, "AR").Value Application.EnableEvents = True End If End If End Sub ** ملحوظة : يفضل العمل على ملف مرفق واحد فقط معبر عن الملف الأصلي لكي لا يحدث تشتت ..الرجاء الانتباه لتلك الملحوظة تقبل تحياتي

الشكر لله اختنا الكريمة

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

اتفضلى جربى الكود بهذه الطريقة على زر جديد ضيفى هذا الكود MS.BackColor = vbWhite MS.ForeColor = vbBlack Me.Requery

الكود اعتقد راح يظبط بهذا الشكل If Me!TS = "قبل الفطور" And Me![MS] >= 0 And Me![MS] <= 84 Then MS.BackColor = vbYellow ElseIf Me!TS = "قبل الفطور" And Me![MS] >= 85 And Me![MS] <= 125 Then Me.MS.BackColor = vbGreen ElseIf Me!TS = "قبل الفطور" And Me![MS] >= 126 Then MS.BackColor = vbRed MS.ForeColor = vbWhite End If

::: تفضل Microsoft Access قاعدة بيانات جديد ‫‬.rar

تفضل اخي الكريم stu1.rar

وعليكم السلام 1. عندك مجموعة اختيارات ، منها: vbBlack vbRed vbGreen vbYellow vbBlue vbMagenta vbCyan vbWhite 2. او استخدام الامر RGB: R = Red G = Green B = Black وهو عبارة عن خلط هذه الالوان الثلاث للحصول على 16 مليون لون ، والكود هكذا: me.TS.backcolor= RGB(0,0,0) 'اسود ومن هذا الرابط مثلا ، تستطيعين معرفة خلطة جميع الالوان تقريبا http://www.rapidtables.com/web/color/RGB_Color.htm 3. واذا كانت عندك خلفيه في برمجة صفحات الانترنت ، فتستطيعين استخدام Hex Code (للأكسس 2007 فما فوق) ، والوانه كذلك موجود في الرابط اعلاه ، مثل #FF0000 للون الاحمر وعلى هذه الاساس ، طلبك يكون: if me.MS>=85 and me.MS<=135 then me.MS.backcolor=vbGreen end if جعفر

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

وعليكم السلام ضع الكود التالي في حدث ورقة العمل (كليك يمين على اسم ورقة العمل ثم اختر الأمر View Code والصق الكود التالي) قم بوضع أية بيانات في الأعمدة من AD إلى AW ولاحظ النتيجة في العمود AN Private Sub Worksheet_Change(ByVal Target As Range) If Target.Row > 7 Then If Target.Column >= 30 And Target.Column <= 49 Then Application.EnableEvents = False Cells(Target.Row, "AN").Value = Cells(Target.Row, "AR").Value Application.EnableEvents = True End If End If End Sub

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

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

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

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

اتفضلى الملف بعد التعديل باضافة الرسالة نظام متابعة مواعيد مرضى السكر_UP.rar يتم وضع الرسالة فى نموذج سكرك على زر الامر أمر21 "ادخال" فيصبح الكود بهذا الشكل If IsNull([MS]) Then MsgBox "من فضلك ادخل مستوى السكر" MS.SetFocus ElseIf IsNull([TS]) Then MsgBox "من فضلك حدد وقت اخذ العينة" TS.SetFocus Else DoCmd.SetWarnings False DoCmd.OpenQuery "سكرك" DoCmd.SetWarnings True 'لمسح قيم عناصر التحكم على النموذج بعد ادخال القيم MS = "" TS = "" MsgBox "تم تسجيل نتيجة التحليل" Me.Requery End If

بعد اذن اخويا الغالى واستاذى الحبيب @محمدنجار يوضع سطر الكود الذى تفضل به اخى العزيز فى التقرير فى مربع النص فى control source ويكون الكود بهذا الشكل =DLast("Current_Research_budget";"Balance") وممكن وضعه فى الاستعلام ويكون بهذا الشكل Last Research Budget: DLast("Current_Research_budget";"Balance") بس للتوضيح لو ترك الكود بهذا الشكل بدون تصفيه ستكون اخر قيمة فى المطلق ولكن لو اردتى اخر قيمة ل id user على سبيل المثال يجب عمل تصفية اولا على هذا الحقل حتى تكون اخر قيمة لهذا id user والله اعلى واعلم

وعليكم السلام تفضلي أختي: الزر موجود في النموذج Form1 ، اولا تأكدي ان تغير الحدث من Private الى Public Public Sub cmd_A_Click() MsgBox "Run A" End Sub ثم من اي مكان او اي نموذج ، ناديه هكذا: Call Form_Form1.cmd_A_Click جعفر

تم التعديل على الكود بدون تفريغ العامود H انظر الى الصفحة salim الكود مرفق (لعدم اظهار المجموع للعامود I) يمكن تعطيل السطر الاخير من الكود (قبل End Sub) و ذلك بكتابة فاصلة عليا في بدايته الكود: Option Explicit Sub extract_data() Dim My_Rg, Cel As Range Dim Roow, Cool As Integer Dim StrJ, StrI, StrH As String Dim OldVal If ActiveSheet.Name <> "salim" Then Exit Sub StrJ = "=D2-I2": StrJ = Replace(StrJ, Chr(34), Chr(34) & Chr(34)) StrI = "=SUM(E2:G2)": StrH = Replace(StrI, Chr(34), Chr(34) & Chr(34)) StrH = "=IF(j2="","",MOD(j2,1))": StrH = Replace(StrH, Chr(34), Chr(34) & Chr(34)) Set My_Rg = Sheets("salim").Range("A1").CurrentRegion Roow = My_Rg.Rows.Count Cool = My_Rg.Columns.Count Set My_Rg = My_Rg.Offset(1).Resize(Roow - 1).Offset(0, Cool - 3).Resize(Roow - 1, 3) ' My_Rg.Select '//////////////////////////////////////////////////////////// My_Rg.Columns(2).Cells(1).Resize(Roow - 1).Formula = StrI My_Rg.Columns(3).Cells(1).Resize(Roow - 1).Formula = StrJ My_Rg.Columns(1).Cells(1).Resize(Roow - 1).Formula = StrH '========================================== OldVal = My_Rg.Columns(1).Cells(1).Resize(Roow - 1).Value '============================================== For Each Cel In My_Rg.Columns(2).Cells(1).Resize(Roow - 1) Cel.Value = Cel.Value + Cel.Offset(0, -1).Value Next '====================================== My_Rg.Columns(1).Cells(1).Resize(Roow - 1) = OldVal My_Rg.Columns(1).Cells(1).Resize(Roow - 1).Offset(Roow).Cells(1) = Application.Sum(OldVal) '\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\\ End Sub كسرالقرش معدل.rar

السلام عليكم ورحمة الله تعالى وبركاته اختنا الكريمة @Rawannnna ان شاء الله تعالى تجدى فى هذا التعديل مرادك كما تريدين واكثر قمت ببعض التعديلات اولا اضافة حقل تاريخ فى جدول تحاليل السكر قولى ليــــه هأقول لك ليه انا علشان سببين الاول : يعنى مفروض يكون عندى خلفية بمستويات السكر فى تواريخ سابقة لمقارنتها بتواريخ حدبثه للتسهيل متابعة ومراقبة المستوى ☺ ثانيا والاهم برمجيا : حتى لا يتكرر ادخل بيانات فى وقت واحد بقرائة واحده او حتى بقراءه مختلفة يعنى مثلا مش ينفع المريض محمد عصام فى تاريخ 2/5/2017 يكون مستوى السكر 300 قبل الافطار ويتم تكرار هذا السجل مرة اخرى وكذلك لا يصح ان يكون المريض محمد عصام فى تاريخ 2/5/2017 يكون مستوى السكر 450 قبل الافطار اى تسجيل نتيجه مختلفة بالخطأ فى وقت غير وقت العينه امممممم معلش انا اسف لانى مستعجل حبتين ولا يسمح وقتى الحالى بالنقاش والحوار والمتابعة الجيدة انا عدلت من نفسي بما رايت فيه الصالح قد اكون مخطئ وقد اكون مصيب فى افكارى فإن أصبت فبفضل من الله سبحانه وتعالى وان اخطأت فمن نفسى فتقبلوا خطأى بحلم كذلك عذرا قمت بتعديل المسميات للعناصر على النموذج لتسهيل التكويد بصراحه انا مش باعرف اكود عربى اممممممم ايضا قمت بمسح مصدر بيانات النموذج وجعلته غير منضم واضفت استعلام جديد لاضافة القيم من النموذج الى الجدول وقت الضغط على زر ادخال البيانات واخيرا وليس اخرا اسال الله تعالى ان يهدينا الى ما فيه الخير والفلاح والصلاح والرشاد واسالكم الدعاء لوالدتى بظهر الغيب فنحن فى امس لحاجة لدعوات صالحات بظهر الغيب نظام متابعة مواعيد مرضى السكر_UP.rar الاستاذ @عبدالله كاظم كل لاشكر والتقدير وجعلكم الله سباقون الى الخيرات دائما وابدا اعتذر منكم وكلى خجل فوالله لم ارى والاحظ ردكم اعتذر منك اخى الكريم

بواسطة المعادلات لا تستطيع عمل ذلك لانك تقع في مشكلة Circular Reference تم التعديل على الماكرو لاظهار الفرق في العامود I و جمعه كسرالقرش SalimA.rar

جرب هذه الملف يجب ان يكون العامودين H & L (حدود جدول النتائج) فارغين كي بعمل الكود بشكل جيد كسرالقرش Salim.rar

أخي العزيز إستخدم الكود التالي Private Sub Form_Open(Cancel As Integer) Dim x As String x = "password" Dim y As String y = InputBox("Enter Password for form") If x <> y Then MsgBox ("Invalid password") DoCmd.CancelEvent End If End Sub قم باستبدال password بكلمة المرور التي تريد في كل نموذج ووافني بالنتيجة ...

اخي العزيز تم تعديل المرفق الثاني ومرفق لك مثالك بعد التعديل ارجو ان تجربه وتخبرنا النتيجة تحياتي,,, SRCH.rar