jjafferr

السلام عليكم 🙂
 
المشكلة ليست في تصدير البيانات الى اكسل ، وانما الصعوبة في عمل مجاميع كل عمود في الاكسل ، وهناك طريقتين لعمل هذا:
أ. تصدير البيانات والتعامل مع بيئة الاكسل (Excel Object) برمجيا ،
ب. عمل مجاميع الاعمدة من الاكسس وتصديرها جاهزة للاكسل ، وانا اتبعت هذه الطريقة 🙂
 
عملت 4 طرق ، وانت تختار الافضل لك:

.
بسبب انه في الاستعلام export_selfa ممكن يكون عندك الاسم مكرر اكثر من مرة () ، فكان لازم نعمل استعلام المجاميع qry_Sum_export_selfa ، بحيث يجمع قيم الموظف في سجل واحد :

.
الطريقة 3. من هنا عملنا التقرير rpt_Sum_export_selfa والذي مصدر بياناته الاستعلام اعلاه ، 
وعملنا تجميع الاعمدة في التقرير:

.
 
الفكرة الاخرى ، ان نعمل مجموع الاعمدة في الاستعلام نفسه ،
والطريقة اللي توصلت لها ، هي عمل استعلام مجاميع الاعمدة فقط qry_Sum_export_selfa_2 :

.
وتكون نتيجتها

.
ثم نعمل استعلام توحيد qry_Sum_export_selfa_3 فيه الاستعلام الاول qry_Sum_export_selfa والثاني qry_Sum_export_selfa_2

.
فتصبح النتيجة

.
الطريقة 1. بتصدير الاستعلام qry_Sum_export_selfa_3 الى اكسل عن طريق الامر TransferSpreadsheet ،
الطريقة 2. بتصدير الاستعلام qry_Sum_export_selfa_3 الى اكسل عن طريق الامر OutputTo ،
الطريقة 4. عمل تقرير من الاستعلام qry_Sum_export_selfa_3 وتصدير التقرير الى اكسل عن طريق الامر OutputTo :

.
 
وهذه اكواد الطرق اعلاه:
Private Sub cmd_Transffer_Query_Click() '1 Dim File_Name As String File_Name = CurrentProject.path & "\" & "تفصيل سلفة متنوعة" & Format(Date, "---DDDD-DD-mmmm-yyyy") & ".xlsx" DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qry_Sum_export_selfa_3", File_Name, True End Sub Private Sub cmd_Output_qry_Click() '2 Dim File_Name As String File_Name = CurrentProject.path & "\" & "تفصيل سلفة متنوعة" & Format(Date, "---DDDD-DD-mmmm-yyyy") & ".xls" DoCmd.OutputTo acOutputQuery, "qry_Sum_export_selfa_3", acFormatXLS, File_Name, True, , , acExportQualityPrint End Sub Private Sub cmd_Output_rpt_Click() '3 Dim File_Name As String File_Name = CurrentProject.path & "\" & "تفصيل سلفة متنوعة" & Format(Date, "---DDDD-DD-mmmm-yyyy") & ".xls" DoCmd.OutputTo acOutputReport, "rpt_Sum_export_selfa", acFormatXLS, File_Name End Sub Private Sub cmd_Output_rpt_3_Click() '4 Dim File_Name As String File_Name = CurrentProject.path & "\" & "تفصيل سلفة متنوعة" & Format(Date, "---DDDD-DD-mmmm-yyyy") & ".xls" DoCmd.OutputTo acOutputReport, "rpt_Sum_export_selfa_3", acFormatXLS, File_Name End Sub  
ونصيحة:
انت مستعمل 160 حقل في الجدول FILE-1 ، ويجب عليك تفكيكه الى على الاقل 3 جداول ، وتربط بينهم برقم الموظف ، ثم في استعلام تجمعهم جميعا !!
 
جعفر
 
 
1486.Database1 (2).accdb.zip

وعليكم السلام 🙂
 
يجب تعديل مصدر بيانات الحقل text37 الى :
اذا قيمة حقل البنزين = 0 اذا اردت قيمة الحقل text37 = "" =IIf([fuel]=0,"",[text35]*20/[fuel]) اذا اردت قيمة الحقل text37 = 0 =IIf([fuel]=0,0,[text35]*20/[fuel]) .
قد تضطر الى استعمال الفاصلة المنقوطة ; بدلا عن الفاصلة في الكود اعلاه.
 
والنتيجة

 
جعفر

وعليكم السلام 🙂
 
هل انت طالب او مدرس ، لأن اسألتك تدور حول بديهيات الاكسس ، كأنها دروس 😁
 
عملت تغيير في النموذج ، فاصبحت الازرار

.
اول 3 ازرار ترسل البيانات مباشرة من النموذج الرئيسي لحقول النموذج الفرعي :
Private Sub cmd_xr_Click() 'عند الضغط على الزر في النموذج الرئيسي xr Me.fx!x = "xr" Me.fx!x1 = 2 Me.fx!x2 = 4 Me.fx!x3 = 1 Me.fx!x4 = 0 End Sub Private Sub cmd_xm_Click() 'عند الضغط على الزر في النموذج الرئيسي xm Me.fx!x = "xm" Me.fx!x1 = 2 Me.fx!x2 = 4 Me.fx!x3 = 1 Me.fx!x4 = 0 End Sub Private Sub cmd_xn_Click() 'عند الضغط على الزر في النموذج الرئيسي xn Me.fx!x = "xn" Me.fx!x1 = 2 Me.fx!x2 = 4 Me.fx!x3 = 1 Me.fx!x4 = 0 End Sub .
الزرين الاخيرين ، ننادي دالتين في النموذج الفرعي :
Private Sub cmd_xs_Click() Call Form_fx.Enter_xs End Sub Private Sub cmd_Subform_Event_Click() Call Form_fx.I_am_MsgBox End Sub .
نعمل دوال في النموذج الفرعي ، ولكي نستطيع ان نراها/نقرأها من خارج النموذج ، يجب ان نستعمل Public  :
Public Sub Enter_xs() Me.x = "xs" Me.x1 = 2 Me.x2 = 4 Me.x3 = 1 Me.x4 = 0 End Sub Public Sub I_am_MsgBox() MsgBox "قيمة x تساوي" & vbCrLf & Nz(Me.x, "") End Sub .
جعفر
1482.fyfx.accdb.zip

هذا كأنه خط يدي 🙂
 
اللي اعتقده مفروض يصير:
Option Compare Database Option Explicit Dim rst_fy As DAO.Recordset Dim rst_n As Integer ' Private Sub namebook_Click() 'take the Recordset one time, use it many times If rst_n = 0 Then Set rst_fy = Forms!freadermain!finfo.Form.RecordsetClone rst_n = 1 End If 'j rst_fy.OpenRecordset rst_fy.FindFirst "namebook='" & Me.namebook & "'" If rst_fy.NoMatch Then rst_fy.AddNew rst_fy!namebook = Me.namebook rst_fy!Serialnamebook = Me.Serialnamebook 'j Me.Parent!finfo.SetFocus 'j DoCmd.GoToRecord , , acNewRec '''''!!!!!! ??? 'j Me.Parent!finfo!namebook = Me.namebook ''''''!!!!!! ??? 'j Me.Parent!finfo!Serialnamebook = Me.Serialnamebook ''''''!!!!!! ??? 'j DoCmd.GoToRecord , , acNewRec ''''''!!!!!! ??? rst_fy.Update Else 'j Me.Parent!finfo.Form.Bookmark = rst_fy.Bookmark Me.Parent!finfo.SetFocus Me.Parent!finfo.Form.Bookmark = rst_fy.Bookmark + 1 'j Me.Parent!finfo!numberreadbook = Me.Parent!finfo!numberreadbook + 1 ''''''!!!!!! ??? End If rst_fy.Close End Sub  
جعفر

وعليكم السلام 🙂
 
اذا عندكم كم كبير من البيانات اللي تريد تستعملها في معيار ، فالافضل ان تعمل لهم جدول خاص ، مثل :

.
ثم في الاستعلام ، في المعيار ، نقول له اننا ما نريد اي من البيانات اعلاه تظهر في المعيار (Not In) :

.
وبعدين نقول له ، كذلك في الحقل Grde ، اذا من اليسار (اول الكلمة) ، اول 17 حرف = "ممارس متخصص مساعد" ، اذن هاي كذلك لا تظهرهم 🙂
 
جعفر
1476.Database28.accdb.zip

وعليكم السلام 🙂
 
علشان تختار اكثر من اسم ، عندك اختيارين:
1. السجل تعمل فيه حقل iSelect من نوع نعم/لا ،
ثم تعمل نموذج مستمر ، ويمكنك ان تختار اكثر من سجل/اسم.
2. تعمل مربع خيار ListBox ، ثم تجعل خيارات 

.
فتستطيع بالنقر مرة على الاسم ان تختاره او تلغي الاختيار

.
وتضع احد الاختيارين في نموذج رئيسي ، 
وتعمل بقية الحقول المطلوبة ، والتي لا تكون مرتبطة بجدول ،
وبعد اختيار الاسماء وتعبئة الحقول ، يكون عندك زر لتفريغ هذه البيانات في الجدول لهذه الاسماء ، سواء ان تُلحق سجل جديد ، او تعمل تحديث لسجل موجود ،
كود الزر يعمل حلقة دوران للاسماء ، ويُدخل بيانات الحقول 🙂
 
جعفر
 

وعليكم السلام 🙂
 
عندك طريقتين لكي "تحدد اليوم الذي يريدة الذي يبدأ الشهر منه" :
1. المعيار في الاستعلام مباشرة (يجب ان تكون الكتابة نفسها في المكانين) :

.
ولما نستخدم الكلمات العربية :

.
هذا هو الكود:
Between [Please enter FROM date] And DateAdd("m",1,[Please enter FROM date])-1 .
2. في النموذج frm_Main في الحقل Date_From :
فيكون المعيار في الاستعلام :

.
Between [Forms]![frm_Main]![Date_From] And (DateAdd("m",1,[Forms]![frm_Main]![Date_From])-1) .
 
وهذا الكود DateAdd("m",1,[Forms]![frm_Main]![Date_From]) معناه اضف :
m = شهر
1 = المدة التي نريد ان نضيفها
[Forms]![frm_Main]![Date_From] = على هذا التاريخ
 
فيعطينا شهر واحد بعد هذا التاريخ ،
ولكنك تريد شهر ناقصا يوم واحد ، لهذا السبب نضيف 1- في نهاية الامر
 
جعفر

تفضل 🙂
 
ضع هذا الكود في النموذج fx
Option Compare Database Option Explicit Dim rst_fy As DAO.Recordset Dim rst_n As Integer ' Private Sub xxx_Click() 'take the Recordset one time, use it many times If rst_n = 0 Then Set rst_fy = Forms!fxy!fy.Form.RecordsetClone rst_n = 1 End If rst_fy.MoveFirst rst_fy.FindFirst "yyy='" & Me.xxx & "'" If rst_fy.NoMatch Then MsgBox "لا يوجد تطابق" Else MsgBox "يوجد تطابق" Me.Parent!fy.Form.Bookmark = rst_fy.Bookmark Me.Parent!fy.SetFocus End If rst_fy.Close End Sub .
جعفر

السلام عليكم 🙂
 
هذا الاستعلام ، ينادي الدالة Add_Ev ونرسل لها قيم التقييم بالتسلسل (بسبب ان اسماء حقولك باللغة العربية ، للأسف نرى ان اسماء الحقول متلخبطة ، بينما ارسلت الحقول بالتسلسل)

.
وهذه هي الدالة تقوم بعمل القيم تحت بعضها البعض:
Function Add_Ev(E1, E2, E3, E4, E5) As String Dim LineBreaker As String LineBreaker = Chr(13) '1 If Len(E1 & "") <> 0 Then Add_Ev = E1 End If '2 If Len(E2 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E2 End If '3 If Len(E3 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E3 End If '4 If Len(E4 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E4 End If '5 If Len(E5 & "") <> 0 Then Add_Ev = Add_Ev & Chr(13) & E5 End If End Function .
التقرير 2 يظهر بهذه الطريقة ، وبدون اي اكواد في التقرير ، وهذا ما اقترحته عليك سابقا

.
اما التقرير التالي ، فالخطوط بين القييمات تأتي من الكود

.
وهذا هو الكود :
Private Sub Detail_Format(Cancel As Integer, FormatCount As Integer) Dim i As Integer Dim x() As String Dim L As Single, T As Single, W As Single, H As Single L = Me.Ev.Left T = Me.Ev.Top W = Me.Ev.Width H = Me.Ev.Height x = Split(Me.Ev, Chr(13)) For i = 1 To UBound(x) T = T + H Me.Line (L, T)-(W, T), vbBlack Next i End Sub  
جعفر
1468.Lines in Report.accdb.zip

تفضل 🙂
Private Sub Npos_AfterUpdate() ' Dim strMsg As String, strTitle As String, MMM As String Dim ttt As Integer, intStyle As Integer ttt = Me.Npos ' TTT = InputBox("Enter number between 1 and 11") Select Case ttt Case 1 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "استعجال المورد بسرعة التوريد _تاريخ / / " Case 2 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "مراسلة المورد باستبدال المهمات المرفوضة _تاريخ / / " Case 3 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "مراسلة المورد بتوفير شهادات المطابقة الفنية _تاريخ / / " Case 4 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "مراسلة المورد بإصدار الرسومات التنفيذية _تاريخ / / " Case 5 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "مراسلة المورد بسداد التامين النهائي _تاريخ / / " Case 6 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "مراسلة المورد بتعديل طريقة الدفع _تاريخ / /" Case 7 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "انذار المورد بالشراء خصما من مستحقاته _تاريخ / /" Case 8 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "مراسلة المشروع بجاهزية المهمات _تاريخ / /" Case 9 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "تحويل من المخازن" Case 10 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "مراسلة المشروع بموافاتنا بالإضافات _تاريخ / /" Case 11 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "تم التوريد بالكامل _تاريخ / /" Case 12 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "تم التحويل للخارجيه" Case 13 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "تم إلغاء امر التوريد _تاريخ / / " Case 14 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "HOLD" Case 15 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "تم عمل تعاقد" Case 16 Me.[Last Situation] = Me.[Last Situation] & vbCrLf & "تم الارسال الى المركز الرئيسى بتاريخ" Case Else MsgBox ("برجاء إختيار رقم من القائمه") End Select Exit_Npos_AfterUpdate: Exit Sub Err_Npos_AfterUpdate: MsgBox Err.Description Resume Exit_Npos_AfterUpdate End Sub  
جعفر

وعليكم السلام 🙂
 
واهلا وسهلا بك في المنتدى 🙂
للاستفادة القصوى من المنتدى ، رجاء قراءة قوانين المنتدى: اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
 
استخدم
="#https://www.google.com/maps/place/" & [N] & " " & [E] .
هذا مثال عملته الآن ، مع مراعاة الحقلين من نوع HyperLink ، ومصدر البيانات من النموذج وليس الجدول :
 

.
والنتيجة

.
جعفر
1466.HyperLink URL.accdb.zip

وعليكم السلام 🙂
 
سيدي الفاضل ، استعمل الطريقة الابسط والاسهل واللي انت تعرفها ، وهي بتفكيك الامر الى اوامر ابسط ، ثم اجمعها ، هذا:
dim mySQL as string mySQL="[TBLibrary]![bookname]=Forms![FLibraryMain]![FLibrarySub].Form![bookname]" mySQL= mySQL & " And " mySQL= mySQL & "[TBLibrary]![Writer]=Forms![FLibraryMain]![FLibrarySub].Form![Writer]" 'اعمل التغيير المطلوب في هذا السطر فقط If DCount("*", "[TBLibrary]", mySQL) >= 1 Then  
وعلشان تتأكد ان المعادلة تعمل ، اوقف عمل السطر الثاني والثالث من المتغير mySQL بوضع علامة ' امام كل سطر ، وجرب 🙂
 
جعفر

وعليكم السلام 🙂
 
هذه الخيارات ، بالاضافة الى خيارات اخرى ، يأخذها الاكسس من الطابعة ، فلا يمكن ان تضيف شيء غير موجود.
فإذا الطابعة لا تطبع A3 وهو ضعف حجم A4 ، فلن تجد هذا الاختيار.
يمكنك ان تضيف طابعة بها خيار A3 ، او تستخدم احد الطابعات الافتراضية التالية:
Microsoft XPS Document Writer
Microsoft Print to PDF
او طابعة افتراضية مجانية لطباعة pdf مثل: https://www.dopdf.com/
او طابعة افتراضية لطباعة الصور.
 
جعفر

وعليكم السلام 🙂
 
السطر المسؤول عن النقل (او اعادة التسمية مع النقل) هو
Name OFN.lpstrFile As Me.Image_Path .
وللنسخ استعمل :
FileCopy OFN.lpstrFile , Me.Image_Path  
جعفر

وعليكم السلام 🙂
 
لاحظ هذا المثال:
استعملنا اسم الحقل الذي في النموذج ، ولم نستخدم اسم الحقل "مصدر المعلومات"

.

.
 
بينما كان يجب ان نستخدم اسم الحقل "مصدر المعلومات"

.
جعفر

تفضل 🙂
 
ولكن يجب ان تختار الجدول الصحيح في الاستعلام ،
ثم يجب ان تغير اسم الحقل من Date_in الى اسم الحقل الحقيقي ، يجب تبديله في المعادلة 🙂
 
اخي حسين ، يجب اضافة الوقت كذلك في معادلتك ، ليس اليوم فقط 🙂
 
جعفر
1459.unix_tTime_Stamp.accdb.zip

تفضل يا سيدي:
 
النموذج يظهر لك جميع البيانات ، ولكن يجب ان تكون متصل بالانترنت

.
كود حدث "عند النقر" على الزر في النموذج :
Private Sub cmd_IP_Country_Click() Dim city_IP As String Dim public_IP As String Me.my_PC_MAC = GetMyMACAddress Me.my_Local_IP = GetMyLocalIP Me.my_country_IP = IPcountry(city_IP, public_IP) Me.my_country_IP = DLookup("[Country_A]", "tbl_Countries_Currency_Codes", "Country_Code_E2='" & Me.my_country_IP & "'") Me.my_Public_IP = public_IP Me.my_city_IP = city_IP End Sub .
والوحدات النمطية التي تقوم بالعمل:
Option Compare Database Option Explicit '---------------------------------------------------------------------------- 'This module contains 3 functions for determing the public IP, the local IP 'and the MAC address of the computer that runs those functions. '  'Written By:    Christos Samaras 'Date:         22/11/2014 'E-mail:        xristos.samaras@gmail.com 'Site:         http://www.myengineeringworld.net '---------------------------------------------------------------------------- Function GetMyPublicIP() As String Dim HttpRequest As Object On Error Resume Next 'Create the XMLHttpRequest object. Set HttpRequest = CreateObject("MSXML2.XMLHTTP") 'Check if the object was created. If Err.Number <> 0 Then 'Return error message. GetMyPublicIP = "Could not create the XMLHttpRequest object!" 'Release the object and exit. Set HttpRequest = Nothing Exit Function End If On Error GoTo 0 'Create the request - no special parameters required. HttpRequest.Open "GET", "http://myip.dnsomatic.com", False 'Send the request to the site. HttpRequest.send 'Return the result of the request (the IP string). GetMyPublicIP = HttpRequest.responseText End Function Function GetMyLocalIP() As String 'Declaring the necessary variables. Dim strComputer As String Dim objWMIService As Object Dim colItems As Object Dim objItem As Object Dim myIPAddress As String 'Set the computer. strComputer = "." 'The root\cimv2 namespace is used to access the Win32_NetworkAdapterConfiguration class. Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") 'A select query is used to get a collection of IP addresses from the network adapters that have the property IPEnabled equal to true. Set colItems = objWMIService.ExecQuery("SELECT IPAddress FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True") 'Loop through all the objects of the collection and return the first non-empty IP. For Each objItem In colItems If Not IsNull(objItem.IPAddress) Then myIPAddress = Trim(objItem.IPAddress(0)) Exit For Next 'Return the IP string. GetMyLocalIP = myIPAddress End Function Function GetMyMACAddress() As String 'Declaring the necessary variables. Dim strComputer As String Dim objWMIService As Object Dim colItems As Object Dim objItem As Object Dim myMACAddress As String 'Set the computer. strComputer = "." 'The root\cimv2 namespace is used to access the Win32_NetworkAdapterConfiguration class. Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2") 'A select query is used to get a collection of network adapters that have the property IPEnabled equal to true. Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_NetworkAdapterConfiguration WHERE IPEnabled = True") 'Loop through all the collection of adapters and return the MAC address of the first adapter that has a non-empty IP. For Each objItem In colItems If Not IsNull(objItem.IPAddress) Then myMACAddress = objItem.MACAddress Exit For Next 'Return the IP string. GetMyMACAddress = myMACAddress End Function Function IPcountry(IPcity As String, IPPublic As String) As String ' 'from: https://www.mrexcel.com/board/threads/need-to-get-location-based-on-ip-address-in-vba.1115981/ 'edited by jjafferr 20-01-22 'we don't send any values when calling the Function, but return 3 values ' Dim http As Object Dim xmlDoc As MSXML2.DOMDocument60 Dim strURL As String ' requires reference to Microsoft XML 6.0 IPPublic = GetMyPublicIP strURL = "https://ipapi.co/" & IPPublic & "/xml/" Set http = CreateObject("MSXML2.XMLHTTP") http.Open "GET", strURL, False http.send Set xmlDoc = New MSXML2.DOMDocument60 xmlDoc.LoadXML http.responseText 'Debug.Print http.responseText IPcity = xmlDoc.SelectSingleNode("//root/city").Text IPcountry = xmlDoc.SelectSingleNode("//root/country").Text End Function .
والدالة الاخيرة هي التي يتم مناداتها من النموذج ، 
اضفت شيء فيه لإرجاع البيانات للنموذج ، فعند مناداة الدالة ، لا نرسل لها اي قيمة ، وانما هي تُرجع 3 قيم للنموذج ، فالطريقة لطيفة للنظر فيها 🙂
 
اسم الدولة التي تُرجعه الدالة هو اختصار اسم الدولة ، فأرفقت احد جداول من احد برامجي فيه بقية بيانات الدوله ، وبقية الدول (الجدول عمره حوالي 8 سنوات ، فقد تكون هناك دول جديدة نشأة من وقتها ، فعليه ، يجب عليك تحديث الجدول 🙂)
 
جعفر
1452.IP Country.accdb.zip

جرب هاي المعادلة في مصدر بيانات حقل مبلغ التقريب:
=Round([المبلغ]/1000,0)*1000  
المبلغ = 284667
نقسمه على 1000 (عدد الخانات التي تريد تقريبها) = 284.667
نقرب الرقم باستخدان الامر Round ، وعدد الخانات العشرية = 0 ، فتكون النتيجة 285
نضرب الرقم في 1000 لكي يرجع لى نفس حجم الخانات السابقة = 285 * 1000 = 285000
 
وبما اننا استعملنا امر التقريب ، فاليك مثال للنتيجة اللرقم التالي:
284499 = 284000
284500 = 284000
284501 = 285000
فأي رقم اكبر من 500 سيتم تقريبه الى الرقم الاعلى.
 
جعفر

تفضل 🙂
 
المرفق فيه ملفين ، والاثنين يعملون نفس العمل ،
ولكن الملف رقم 2 عملته خصيصا لـ @Moosak لأنه يعمل كوحدة نمطية 🙂
 
الفكرة مثل اول مشاركة ، نعمل حقل مؤقت :

.
ثم عملت تنسيق شرطي لجميع الحقول ، اذا كانت قيمة الحقل "رقم_التذكرة" موجودة في قيمة الحقل المؤقت ، اجعل لون السطر أخضر (والسبب في اختيار حقل رقم_التذكرة ، لأن بياناته غير متكرر) :
1. نختار جميع الحقول ،
2. ننقر على زر التنسيق الشرطي

.

.
هذه هي المعادلة بالطريقة الصحيحة:
InStr([tmp_ticket_No],"|" & [رقم_التذكرة] & "|")>0 .
وهذا هو الكود
Private Sub Form_Current() Me.tmp_ticket_No = "|" & Me.[رقم_التذكرة] & "|" End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single) 'Me.SelHeight = to specify or determine the number of selected rows 'Me.SelTop = to specify or determine which row (record) is topmost in the current selection ' if no selection If Me.SelHeight = 0 Then Exit Sub Dim i As Integer Dim rst As dao.Recordset Set rst = Me.RecordsetClone rst.MoveFirst ' if the user pressed the Shift or Control key on the keyboard, 'then don't clear the previous selection If Shift <> acShiftMask And Shift <> acCtrlMask Then 'clear the previous selection Me.tmp_ticket_No = "" End If ' Move to the first selected record. rst.Move Me.SelTop - 1 ' Loop through the selected records For i = 1 To Me.SelHeight ' add the selected Records to the tmp field Me.tmp_ticket_No = Me.tmp_ticket_No & "|" & rst![رقم_التذكرة] & "|" rst.MoveNext Next i rst.Close: Set rst = Nothing 'Debug.Print Me.tmp_ticket_No End Sub .
والنتيجة

 
جعفر
1457.تلوين سجل محدد.accdb (2).zip

وعليكم السلام 🙂
 
فيه مثال بسيط في هذه المشاركة ، من سطر امثلة عملية:
.
 

السلام عليكم اخي حسين 🙂
 
كنت اعمل على طريقة اوسع من طلبك ، والحمدلله اخونا عمرو افرد موضوع لهذه الطريقة ، هنا
.
فللقيام بما تريد ، اعمل ملف bat. ، واكتب فيه اسم الملف الذي تريد حذفه ، هكذا :
del /f "D:\CBR\TST.txt" واستعمل طريقة اخونا عمرو كما هو في الرابط اعلاه ، ليقوم بتشغيل ملف bat. حسب الاوقات التي تحب 🙂
 
جعفر

همممم
يصير مع النماذج: http://allenbrowne.com/ser-35.html
 
والمرفق من الرابط 🙂
 
جعفر
MultiInstance2k.zip

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

وعليكم السلام 🙂
 
الخطأ الابسط:
عندكم خطأ في اسم الحقل في المعادلة ، يجب ان تكون بالمقلوب:

واردت اتاكد ان الكلمات العربية ما قلبت الكود :

 
والخطأ الاكبر:
النموذج مرتبط بجدول ، فأي تغيير في بياناته يجعلك تغير بيانات الجدول ،
فلما تدخل رقم الهوية (لسبب مؤقت وهو البحث) في حقل مرتبط في الجدول ، فانت تُخبر نظام قاعدة البيانات بأنك في وضع تعديل:
.
.
فالطريقة الصحيحة ان يكون عندك حقل غير مضمن للبحث ، هكذا مثلا:

.
ثم تستعمل هذا الكود على حدث "بعد التحديث"
Private Sub srch_Card_AfterUpdate() Dim X As Long Dim i As String Dim xSplit() As String X = Me.srch_Card.Text 'i = DLookup("[aa] & '|' & [bb] & '|' & [cc]", "BeneficiaryT", "[رقم الهوية]=" & X) i = Nz(DLookup("[الاسم] & '|' & [اسم الاب] & '|' & [العائلة]", "BeneficiaryT", "[رقم الهوية]=" & X), "There_Are_No_Records_Here") If i <> "There_Are_No_Records_Here" Then xSplit = Split(i, "|") i = xSplit(0) & " " & xSplit(1) & " " & xSplit(2) MsgBox "رقم الهوية" & " ( " & X & " ) " & " تم تسجيله مسبقاُ" & "بأسم" & " " & i, vbCritical, " تنبيه" Me.card.SetFocus DoCmd.FindRecord X, , , , , , True DoCmd.GoToControl "srch_Card" Me.srch_Card.SetFocus Else MsgBox "لا يوجد سجل لهذه الهوية", vbCritical, " تنبيه" Exit Sub End If End Sub .
 
وتلاحظ اني لم استدعي البيانات من الجدول 3 مرات باستعمال 3 اوامر Dlookup ، وانما استدعيتها مرة واحدة (هذا جدا مهم خصوصا لما تكون قاعدة بياناتك مقسمة وعلى السرفر ويستعملها اكثر من مستخدم ، فيجب ان تقلل من زياراتك للجدول ، حتى تخفف العبء عليها وعلى الشبكة) 🙂
 
جعفر