jjafferr

السلام عليكم 🙂 انا استخدم هذه الوحدة النمطية: Option Compare Database Option Explicit '--------------------------------------------------------------------------------------- ' Procedure : EnableArrowsScroll ' Author : Daniel Pineault, CARDA Consultants Inc. ' Website : http://www.cardaconsultants.com ' Purpose : Enable using the up and down arrows to move between records on a ' continuous form ' Req'd Refs: None ' The Form's Key Preview property must be set to True for this code to work. ' ' Input Variables: ' ~~~~~~~~~~~~~~~~ ' iKeyCode : Keycode from the source form from the KeyDown event ' frm : form object to apply the new behavior to ' ' Usage: ' ~~~~~~ ' KeyCode = EnableArrowsScroll(KeyCode, Me) 'This is placed in the KeyDown event ' 'Dont forget to set the Key Preview property to Yes ' ' Revision History: ' Rev Date(yyyy/mm/dd) Description ' ************************************************************************************** ' 1 2011-07-07 Initial Release ' 2 2017-04-08 Added DefaultView check '--------------------------------------------------------------------------------------- Public Function EnableArrowsScroll(ByVal iKeyCode As Integer, frm As Access.Form) As Integer On Error GoTo Error_Handler If frm.DefaultView = 1 Then 'Only process for Continuous forms Select Case iKeyCode Case vbKeyDown ' If CurrentRecord <> RecordsetClone.RecordCount Then 'Restrict to existing records If frm.NewRecord = False Then 'Allow going to new record for data entry DoCmd.GoToRecord , , acNext End If EnableArrowsScroll = 0 Case vbKeyUp If frm.CurrentRecord <> 1 Then DoCmd.GoToRecord , , acPrevious End If EnableArrowsScroll = 0 Case Else EnableArrowsScroll = iKeyCode End Select Else EnableArrowsScroll = iKeyCode End If Error_Handler_Exit: On Error Resume Next If Not frm Is Nothing Then Set frm = Nothing Exit Function Error_Handler: If Err.Number <> 2105 Then MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: EnableArrowsScroll" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" End If Resume Error_Handler_Exit End Function . وتناديها على حدث "الزر الاسفل" للنموذج ، هكذا Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer) On Error GoTo Error_Handler KeyCode = EnableArrowsScroll(KeyCode, Me) Error_Handler_Exit: On Error Resume Next Exit Sub Error_Handler: MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _ "Error Number: " & Err.Number & vbCrLf & _ "Error Source: Form_KeyDown" & vbCrLf & _ "Error Description: " & Err.Description & _ Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _ , vbOKOnly + vbCritical, "An Error has Occurred!" Resume Error_Handler_Exit End Sub . جعفر 1532.UseArrow.mdb.zip

والاهم ان المستخدم ما يرجع للمبرمج لما يريد اضافة او تغيير في النصوص 🙂 جعفر

اتفق مع اخي موسى 🙂 ولكن الافضل عمل جدول وادخال هذه البيانات (وغيرها في المستقبل) في حقل ، وحقل آخر للرقم ، ومن ثم استخدام الاستعلام او دالة لقراءة النصوص وتحويلها لارقام 🙂 جعفر

وعليكم السلام 🙂 هناك عدة مواضيع تناقش طلبك ، فالبحث في المنتدى سيعطيك الكثير من النتائج ، اليك احدها جعفر

كفيت ووفيت ، شكرا جزيلا 🙂 الآن مشاركتك اصبحت مرجع للاعضاء 🙂 جعفر

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

طريقة اخوي ابوبسملة صحيحة اذا كان الحقلين 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 . جعفر

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

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