jjafferr

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

طريقة اخوي ابوبسملة صحيحة اذا كان الحقلين D و M ارقام ، وإلا اليك الطريقة اللي في الرابط اعلاه : dim myWhere as string myWhere="[D] =" & rs!degree1 'اذا الحقل رقم 'myWhere="[D] ='" & rs!degree1 & "'" 'اذا الحقل نص myWhere= myWhere & " and " myWhere=myWhere & "[M]=" & rs!step1 'اذا الحقل رقم 'myWhere=myWhere & "[M]='" & rs!step1 & "'" 'اذا الحقل نص rs!NewAsmi = DLookup("[R]", "Ratib_Tb", myWhere) . وبهذه البساطة تقدر تعمل الامر Dlookup بدون اخطاء 🙂 وطبعا اذا استخدمت نموذج ولد بلادك موسى في هذا الموضوع ، فهو تلقائيا يعرف العلوم ويضبط امورك 🙂 جعفر

يا ابو احمد ، خليتني انط من على الكرسي وانا اقول بسم الله ما شاء الله واصلي على النبي ، على هذاالسطر الجميل ، وبعد رسائل الخطأ ، اكتشفت انك تنادي الدالة DialogColor ، بس نسيت ترفقها لنا 😁 'https://www.devhut.net/vba-choosecolor-api-x32-x64/ #If VBA7 Then Private Type ChooseColor lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr rgbResult As Long lpCustColors As LongPtr flags As Long lCustData As LongPtr lpfnHook As LongPtr lpTemplateName As String End Type #Else Private Type ChooseColor lStructSize As Long hwndOwner As Long hInstance As Long rgbResult As Long lpCustColors As Long flags As Long lCustData As Long lpfnHook As Long lpTemplateName As String End Type #End If Private Const CC_ANYCOLOR = &H100 'Private Const CC_ENABLEHOOK = &H10 'Private Const CC_ENABLETEMPLATE = &H20 'Private Const CC_ENABLETEMPLATEHANDLE = &H40 Private Const CC_FULLOPEN = &H2 Private Const CC_PREVENTFULLOPEN = &H4 Private Const CC_RGBINIT = &H1 'Private Const CC_SHOWHELP = &H8 'Private Const CC_SOLIDCOLOR = &H80 #If VBA7 Then Private Declare PtrSafe Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long #Else Private Declare Function ChooseColor Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As ChooseColor) As Long #End If Public Function DialogColor(Optional lDefaultColor As Variant) As Long Dim CC As ChooseColor Dim lRetVal As Long Static CustomColors(16) As Long 'Some predefined color, there are 16 slots available for predefined colors 'You don't have to defined any, if you don't want to! CustomColors(0) = RGB(255, 255, 255) 'White CustomColors(1) = RGB(0, 0, 0) 'Black CustomColors(2) = RGB(255, 0, 0) 'Red CustomColors(3) = RGB(0, 255, 0) 'Green CustomColors(4) = RGB(0, 0, 255) 'Blue With CC .lStructSize = LenB(CC) .hwndOwner = Application.hWndAccessApp .flags = CC_ANYCOLOR Or CC_FULLOPEN Or CC_PREVENTFULLOPEN Or CC_RGBINIT If IsNull(lDefaultColor) = False _ And IsMissing(lDefaultColor) = False Then .rgbResult = lDefaultColor 'Set the initial color of the dialog .lpCustColors = VarPtr(CustomColors(0)) End With lRetVal = ChooseColor(CC) If lRetVal = 0 Then 'Cancelled by the user DialogColor = RGB(255, 255, 255) ' White -> 16777215 Else DialogColor = CC.rgbResult End If End Function جعفر

وعليكم السلام 🙂 هنا تلقى مجموعة من الحلول . والخطأ اللي يظهر لك معناه هناك خطأ في البحث في "نوع البيانات" ، وهنا ستجد طريقة سهلة بدون ان تخطأ جعفر

وعليكم السلام 🙂 1. اضافة جميلة وملف صوت مميز ، والاحلى انك جمعت المرفقات في مجلد واحد 🙂 2. انا كذلك كنت مستغرب من هذا ، وبحثت ولم اصل الى نتيجة ، وبعدها جرّبت واقتنعت 🙂 وكذلك للتجربة ، 1. افتح برنامجك ، 2. اذهب الى مجلد البرنامج ، احذف المجلد Tools ، ستجد بان الوندوز حذفه ، 3. رجاء ارجاع المجلد Tools مرة اخرى ، باستعمال Ctrl + Z ، 4. افتح اي من النموذجين Up او Dn ، 5. اذهب الى مجلد البرنامج ، احذف المجلد Tools ، ستجد بأنك لا تستطيع حذفه ، لأن الوندوز يستعمل ملف الخط ، 6. اغلق النموذج الذي فتحته ، 7. اذهب الى مجلد البرنامج ، احذف المجلد Tools ، وستجد ان الوندوز حذفه ، 8. رجاء ارجاع المجلد Tools مرة اخرى ، باستعمال Ctrl + Z ، من هنا نرى ، انه اذا كان الوندوز يستخدم ملف الخط ، فلن يحذف المجلد. 9. اعمل هذا التغيير على احد النموذجين Up او Dn ، Private Sub Form_Close() 'Call RemoveFonts(CurrentProject.Path & "\Tools\digital-7 (mono).ttf") Call RemoveFonts("digital-7 (mono).ttf") Call RemoveFonts("C:\Windows\Fonts\digital-7 (mono).ttf") End Sub 10. افتح النموذج ثم اغلقه ، 11. اذهب الى مجلد البرنامج ، احذف المجلد Tools ، ستجد بأنك لا تستطيع حذفه ، لأن الوندوز يستعمل ملف الخط ، من هنا عرفت انه لسبب ما 🙂 وللمحترفين ، هناك طريقة اخرى لمعرفة اذا قام الكود بحذف الخط من الوندوز ، باضافة Debug لمعرفة نتيجة عمل Api : 1 = تم حذف الخط ، 0 = لم يتم حذف الخط (ونلاحظ انه مرتين ، لأن الكود الاخير فيه حذف الخط من مسارين) : جعفر

وعليكم السلام 🙂 هناك عدة محاولات هنا جعفر

واذا تسمح لي اخوي ابو احمد ، بجعل البرنامج تلقائيا يستخدم الخط ويحذفه عند الخروج من البرنامج (استخدمت هذه الطريقة في احد برامجي في لخط الباركود 🙂 ) ، وعليه ، صورة نموذجك بالخط الصحيح سيكون . والوحدة النمطية لإضافة وحذف الخط Private Declare PtrSafe Function AddFontResource Lib "gdi32.dll" Alias "AddFontResourceA" ( _ ByVal lpFileName As String) As Long Private Declare PtrSafe Function RemoveFontResource Lib "gdi32" Alias "RemoveFontResourceA" ( _ ByVal lpFileName As String) As Long ' Public Function AddFonts(Font_Name_Path As String) Dim result As Long result = AddFontResource(Font_Name_Path) 'MsgBox Result & " fonts added" End Function Public Function RemoveFonts(Font_Name_Path As String) Dim result As Long result = RemoveFontResource(Font_Name_Path) 'MsgBox Result & " fonts added" End Function . وننادي الاضافة عند فتح النموذج ، ثم ننادي الحذف عند اغلاق النموذج: Private Sub Form_Open(Cancel As Integer) Call AddFonts(CurrentProject.Path & "\Digital_Font\digital-7 (mono).ttf") End Sub Private Sub Form_Close() Call RemoveFonts(CurrentProject.Path & "\Digital_Font\digital-7 (mono).ttf") End Sub . مع مراعاة اني عملت مجلد للخط "digital-7 (mono).ttf" اسميته Digital_Font في مجلد البرنامج . جعفر StopWatch.zip

وعليكم السلام 🙂 هذا الموضوع ممكن ينفعك جعفر

اسمه Digital ، وعند البحث عن خط digital ، اول رابط حصلت عليه https://www.1001fonts.com/digital-7-font.html جعفر

السلام عليكم 🙂 عمل مبدع ، وكود نظيف وسهل التتبع 🙂 الشيء الوحيد اللي عدّلت فيه هو ، عند النقر على ايقاف الساعة ، كانت تختفي ، فقمت بإيقاف السطر 🙂 Me.txtRemainTime = Null جعفر

السلام عليكم 🙂 متابع 🙂 جعفر

الطلب كان :

اخي biskra ، النموذج المطلوب منبثق مشروط (Popup=Yes, Modal=Yes) ، وهذه هي المشكلة 🙂 جعفر

وعليكم السلام 🙂 تفضل . ولكن لا يمكنك التعامل من تحرير/تعديل/اضافة/اغلاق إلا مع اخر نموذج تم فتحه ، هل ثمن استعمال منبثق مشروط !! . وكنت سأشير الى الموضوع الذي وضع اخوي ابو ابراهيم رابطه 🙂 جعفر 1530.Four_Forms.mdb.zip

الآن فقط انتبهت انك: تبحث في حقلين عن طريق حقلين ، شيء جميل جعفر

حياك الله اخوي 🙂

وعليكم السلام ورحمة الله وبركاته 🙂 اولا خليني اوضح ، سجلات قاعدة البيانات مو مثل الاكسل ، تقدر تغير مكان الخليه بتحريكها من مكانها ، في قاعدة البيانات نستخدم الفرز كطريقة لتحديد مكان السجل (سطر السجل) بين السجلات. بالنسبة لطلبك ، 1. فالاسهل عمل حقل تسلسل ولنسميه Seq ، ونعمل تحديث لبيانات هذا الحقل ، ليتناسب مع الاسم الذي تم اختياره (طبعا هذا حسب اعتقادي بأنك لا تريد تكرار السجل) ، 2. ما فهمت قصدك بالبدء من السجل الثاني ، طيب وشو يكون في السجل الاول ؟ جعفر

السلام عليكم 🙂 اخي UserUser2 انظر الفرق بين طريقة وضعك الكود: . بينما اذا استعملت الطريقة الخاصة لتنسيق الكود . ووضعت الكود في النافذة المنبثقة: . سيكون الكود بهذا التنسيق الجميل ، والجميع يقدر يقراءه 🙂 Private Sub Form_Timer() Dim Hours As String Dim Minutes As String Dim Seconds As String Dim MilliSec As String Dim msg As String Dim ElapsedMilliSec As Long ElapsedMilliSec = Me.Text15.Value - (GetTickCount() - StartTickCount) + _ TotalElapsedMilliSec Hours = Format((ElapsedMilliSec \ 3600000), "00") Minutes = Format((ElapsedMilliSec \ 60000) Mod 60, "00") Seconds = Format((ElapsedMilliSec \ 1000) Mod 60, "00") MilliSec = Format((ElapsedMilliSec Mod 1000) \ 10, "00") Me!ElapsedTime = Hours & ":" & Minutes & ":" & Seconds & ":" _ & MilliSec If Me!ElapsedTime = "00:00:00:00" Then Me.[test Name].BackColor = RGB(225, 0, 0) PlaySound Application.CurrentProject.Path & "\sounds\test.WAV" DoCmd.Restore TotalElapsedMilliSec = TotalElapsedMilliSec + _ (GetTickCount() - StartTickCount) Me.TimerInterval = 0 TotalElapsedMilliSec = 0 Me!ElapsedTime = "00:00:00:00" Me!btnStartStop.Caption = "start" Me.btnReset.Enabled = True End If . جعفر

وعليكم السلام 🙂 اما انا ، فاعمل كل شرط على سطر مستقل ، مثل ما قال اخوي خالد ، وخصوصا لما تكثر الشروط ، وتختلف بين النص والرقم والتاريخ 🙂 . جعفر

اذا كان قصدك عند الخروج من النموذج ، وفيه حقول فارغة ، فالجواب نعم ، وهذا هو الهدف من الكود !! جعفر

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

وارفقت المرفق في مشاركتي السابقة 🙂 جعفر

دكتور @الحلبي اسمح لنا ناخذ راحتنا شوي 🙂 كلنا نستعمل كود اخونا @ابوبسمله ، اللي اعاد ترويضه اخونا @Moosak ، واخونا @مبرمج متقاعد 🙂 طيب ايش رايكم في اخبارنا بجميع الحقول الفارغة ، وبرسالة واحدة : Option Compare Database Private Sub Form_BeforeUpdate(Cancel As Integer) Dim I_am_Empty As String, Set_Focus_On_Me As Control Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If Len(ctl.Value & "") = 0 Then I_am_Empty = I_am_Empty & vbCrLf & ctl.Name Set Set_Focus_On_Me = ctl End If End If Next ctl If Len(I_am_Empty & "") <> 0 Then Cancel = True MsgBox "رجاء تعبئة الحقول الفارغة التالية" & I_am_Empty Set_Focus_On_Me.SetFocus Set ctl = Nothing: Set Set_Focus_On_Me = Nothing Exit Sub End If End Sub . جعفر عدم الحفظ.zip

السلام عليكم 🙂 وبتعديل على كود اخوي موسى : الرسالة تخبرك اي حقل فارغ ، تلغي عملية الحفظ ، ويكون التركيز على الحقل الفارغ : Private Sub Form_BeforeUpdate(Cancel As Integer) Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox Then If Len(ctl.Value & "") = 0 Then MsgBox "رجاء تعبئة الحقل الفارغ " & ctl.name Cancel = True ctl.setfocus exit for End If End If Next ctl End Sub . وانا كذلك مثل اخوي خالد ، لم اقم بتجربة الكود 🙂 جعفر

وعليكم السلام اخي هيثم 🙂 برنامجك المرفق اخذ منك وقت تعمله ، والمشكلة اخذت منك وقت حتى تفكر في حلها ، ولم تجد لها حل ، فليش تبخل علينا بوقتك وتشرح لنا طلبك بالتفصيل وبالصور 🙂 في وقت كتابتي هنا ، 33 عضو دخلوا في موضوعك ، ولم بفهموا المطلوب ، فانتقلوا الى موضوع آخر 🙂 اما انا فانزلت المرفق ، وكذلك ما فهمت المطلوب !! ساعدنا علشان نساعدك 🙂 جعفر