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

احنا ما تفقنا يا استاذ فايز ان الصورة فيها الجزء المفيد فقط ، حتى نقدر نشوف الخطأ وين 🙂 لا يمكن استيراد البيانات بالطريقة السابقة ، لهذا السبب وجب علينا ان نمشي بها سطر بسطر : Dim ImportFileName As String Dim rst1, rst2 As DAO.Recordset Dim i As Long ImportFileName = Me.txtPath CurrentDb.Execute ("Delete * From Table1") CurrentDb.Execute ("Delete * From Temp4") DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "Temp4", ImportFileName, False Set rst1 = CurrentDb.OpenRecordset("Select F2 From Temp4 Where F2 Is Not Null") Set rst2 = CurrentDb.OpenRecordset("Select * From Table1") rst2.AddNew Do Until rst1.EOF i = i + 1 If i = 1 Then rst2![Academic Year] = rst1!F2 ElseIf i = 2 Then rst2![Academic Num] = Mid(rst1!F2, InStrRev(rst1!F2, " ") + 1) ElseIf i = 3 Then rst2![StName] = rst1!F2 ElseIf i = 4 Then rst2![F1] = rst1!F2 ElseIf i = 5 Then rst2![Subjects] = rst1!F2 End If rst1.MoveNext Loop rst2.Update rst1.Close: Set rst1 = Nothing rst2.Close: Set rst2 = Nothing MsgBox "تم استيراد البيانات بنجاح" 'F2 '1=1438-1439 '2=الرقم الأكاديمي 38002 '3=يوسف بن رضا بن حسن مصباح '4=المواد المسجلة في الفصل الدراسي الثاني 1440-1441 '5=رياضيات 4 الشعبة 5 - تربية صحية وبدنية الشعبة 5 - اللغة العربية 4 الشعبة 5 - إنجليزي 4 الشعبة 5 - أحياء 2 الشعبة 5 جعفر Posters.zip

وعليكم السلام 🙂 IIf([name]="A" or [name]="B",500,700) جعفر

من الأخطاء الشائعة في المنتدى تعريف المتغيرات بصورة غير صحيحة في الـ VBA، مع أن هذه الطريقة صحيحة في بعض اللغات. والخطأ هو صف مجموعة متغيرات في تعريف واحد ، وفي هذه الحالة سوف يتم تعريف المتغير الأخير فقط أما المتغيرات التي قبله سوف سوف يكون نوعها Variant والصح هو تعريف كل متغير على حدى مثال: 'الخطأ Sub Test() Dim a, b As Double Dim rst1, rst2 As Recordset Debug.Print VarType(a) Debug.Print VarType(b) Debug.Print VarType(rst1) Debug.Print VarType(rst2) End Sub 'الصح Sub Test2() Dim a As Double, b As Double Dim rst1 As Recordset, rst2 As Recordset Debug.Print VarType(a) Debug.Print VarType(b) Debug.Print VarType(rst1) Debug.Print VarType(rst2) End Sub

عندي طريقة لربما تعتبر طريق فرعي وترابي ايضا مقارنة بطريقة أخي @jjafferr سوف ارفقها ..... بشرط أن يضع لنا الاستاذ جعفر طريق سريع ومسفلت ... Sub RecordPorssesing() On Error Resume Next Dim rs, rs2, rsq As Recordset, Dbs As Database Dim StrSql As String Dim x, r, I, p, z As Integer Set Dbs = CurrentDb Set rsq = Dbs.OpenRecordset("Temp4") Set rs = Dbs.OpenRecordset("SELECT Temp4.F2 FROM Temp4 WHERE (((Temp4.F2) Is Not Null));") rsq.MoveLast rsq.MoveFirst For z = 1 To rs.RecordCount Step 5 For I = 1 To rsq.RecordCount Step 5 Set rs2 = Dbs.OpenRecordset("tbl_bar") rs2.AddNew rs2.Fields(0) = rsq.Fields(0) r = 0 For p = 1 To 5 rs2.Fields(r) = rs.Fields(0) r = r + 1 rs.MoveNext Next p rs2.Update rsq.MoveNext Next I Next z Set rs = Nothing Set rs2 = Nothing Set rsq = Nothing DoCmd.OpenTable "tbl_bar" End Sub Posters.accdb

فورم اكسل للبحث عن ايات القران الكريم وتفسيره ورقم الجذء والصفحة الفيديو فورم بحث عن ايات القران الكريم واجزائة.xlsm

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

الكثير منّا يحاول ادخال التاريخ في الكومبوبوكس لكن المشكلة انه يظهر بالتنسيق الأميركي (شهر /يوم /سنة) بحلية بسيطة يمكننا ان نخدع الاكسل لأدخال التاريخ في الكومبوبوكس كما نريد نحن (يوم/شهر/ سنه) اذ ليس الامر باختياره انظر الى الملف المرفق لتعرف ماذا اعني Reel_date_to Combo.xlsm

بصراحة ... هذه عملية استفزاز لك ... حتى تخرج لنا بعض الكنوز التي لديك لنستفيد منها .... بارك الله فيك اخي @jjafferr

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

شكراً لك أستاذي ومعلمي جعفر وهذه بعض محاولاتي لإنشاء مربع قيم متعددة تضاف القيمة بالنقر مرتين وتزال القيمة أيضا بالنقر مرتين . وهذا كود مربع القائمة Private Sub listBoox_DblClick(Cancel As Integer) 'inStr = "لمعرفة موضع ظهور السلسلة النصية" Text9 = InStr(1, txt1, listBoox.Column(0), vbTextCompare) If Text9 = 0 Or Len(txt1 & "") = 0 Then 'For Each = "الدوران على القيم وإَضافتها إلى حقل المستهدف" For Each m In listBoox.ItemsSelected txt1 = txt1 & listBoox.ItemData(m) & ";" Next Else 'في حال إضافة القيمة مرة أخرى يتم الحذف txt1 = Replace(txt1, listBoox & ";", "") End If End Sub وكود إخفاء وإظهار مربع القائمة Private Sub C_List_Click() If C_List.Caption = "إظهار" Then listBoox.Left = txt1.Left listBoox.Top = txt1.Top + txt1.Height listBoox.Height = 1400 listBoox.Width = txt1.Width listBoox.Visible = True C_List.Caption = "إخفاء" Else C_List.Caption = "إظهار" listBoox.Visible = False End If End Sub بالمرفق الملف SQL_multivalue_field.zip

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

مثال تطبيقي حول التعامل مع المتصفح: الدخول إلى موقع أوفيسنا في متصفح Internet Explorer من خلال الأكسس المثال التالي يمكننا من إدخال اسم المستخدم و كلمة مرور أوفيسنا و عند الضغط على زر الدخول يفتح الموقع بحسابك الخاص في متصفح أنترنت أكسبلورر Dim HTMLDoc As HTMLDocument Dim oBrowser As InternetExplorer Dim oHTML_Element As IHTMLElement Dim sURL As String On Error GoTo Err_Clear sURL = "https://www.officena.net/ib/login/" Set oBrowser = New InternetExplorer oBrowser.Silent = True oBrowser.Navigate sURL oBrowser.Visible = True Do ' Wait till the Browser is loaded Loop Until oBrowser.ReadyState = READYSTATE_COMPLETE Set HTMLDoc = oBrowser.Document HTMLDoc.all.auth.Value = Me.str_UserName HTMLDoc.all.Password.Value = Me.str_Password HTMLDoc.getElementById("elSignIn_submit").Click ' oBrowser.Refresh ' Refresh If Needed Err_Clear: If Err <> 0 Then 'Debug.Assert Err = 0 Err.Clear Resume Next End If فتح موقع أوفيسنا.rar

كلام الاستاذ صحيح ، ولكن : ممكن عمل التالي (انا اكتب واعرض الكود حاليا وبدون التأكد منه ، فرجاء التأكد) ، تقدر تعمل التالي : اسم التقرير rpt_1 ، واسم الحقل Text1 ، ومن زر فتح التقرير ، من النموذج : docmd.openreport "rpt_1", acviewPreview Reports!rpt_1!Text1 = "نحن نقوم بالتجربة على البطاقة رقم " & me.ID جعفر

للتو انتبهت أنك عدلت على كود السائل ، وللتو عرفت ما يريد من الكود لأن العربي كان غير مقروء ، وتعديلي كان "عمياني" بدون أن أفهم الرسائل 🙂 لقد قمت بتصميم نموذج وإضافة Checkbox باسم dd ولصق كود السائل في حدث AfterUpdate وبعد أن أصبحت نصوص الرسائل مقروءة ، أنصح السائل أن يعمل زرين أحدهما للإضافة وأخر للحذف أفضل من هذه الطريقة الغريبة!! ، وربما له هدف لا نعرفه من هذه الطريقة فإذا عرف السبب بطل العجب.

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

تفضل يمكنك استخدام هذا الكود Sub Remove_Duplicates() Range("f5:f1000").RemoveDuplicates Columns:=1, Header:=xlYes End Sub ولو حابب حذف المكرر بدون أكواد ..يمكنك هذا بعد تحديد العمود الذى تريد حذف المكرر منه.ثم الذهاب الى قائمة Data ثم الضغط على Remove Duplicates ... وهذا موضح بالصورة المرفقة Remove Duplicate.xlsm

وعليكم السلام اخوي صالح 🙂 هذه الخاصية موجودة في الاكسس فقط (مثل Lookup في الجدول) ، فيجب عليك ان تتعامل معهم بطريقة اخرى ، قبل ان تنتقل الى SQL Server 🙂 احد الطرق هي ان تجعل هذه القيم في جدول آخر ، وفي النموذج تعامله كنموذج فرعي 🙂 منقول ومترجم من: https://answers.microsoft.com/en-us/msoffice/forum/all/access-multivalue-field-convert-to-ms-sql/05e4ebe9-d919-44c6-bf76-efe47e0d5cae جعفر

وعليكم السلام-لا يمكن عمل أكثر من ذلك 1برنامج.xlsm

السلام عليكم لقد قمت بتصحيح الكود كما جاء في الرابط: سأضع المثال كما أمرتم. جزاكم الله كل خير أستاذ @jjafferr لقد كتبت الكود السابق خطأ، في المرفق الفكرة كما أردت طرحها. Database1.accdb

همم ، وانا وقعت في هذا الخطأ ، يمكن لأني كنت دايخ😁 شكرا لك اخي الهاوي 🙂 جعفر

على العموم ، انا مجهز البخور ، فالجماعة جاهزين معاي 😁

شو السالفة !! اشوف متفقين عليّ 😁 لا تكونوا متراهنين ، وتنتظرون تشوفون من بيفوز !! انا آسف ، ما ممكن اتابع ، إلا بأن اشوف ملف التلاميذ كلهم ، وإلا فمافيه فائدة 🙂 جعفر

توقعاتي صحيحة ..... ههههههه .... لانه لا يعقل ان نعمل كود لطالب واحد .....

اعتقد قراءة لفكر فايز ( اريدها لأكثر من سجل ) ........ صح يا استاذ / فايز

يا ريت ترفق لنا مثال حتى نستفيد 🙂 جعفر

السلام عليكم لقد قدم أساتذتي -جزاهم الله كل خير-الجواب على هذه المسألة. وأضيف من تجربتي: يمكنكم ذلك بجعل تصميم النموذج هو تصميم التقرير- فعلياً لا وجود للتقرير- ومن ثم فإنك تطبع النموذج نفسه. أو بإضافة عنصر تحكم نموذج تجعل مصدره التقرير من خلال الكود: Me.subFormName.Sourceobject "ReportName.rep"= عندها سيظهر التقرير ضمن النموذج وستتمكن من تدارك التعديلات قبل الطباعة ودون الخروج من النافذة. الشكر للأستاذ رمهان فمنهم تعلمت طريقة عرض التقرير ضمن النموذج.

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

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

طيب فـــين الجدول الذى تتحدث عنه , من فضلك ارفع ملف موضح عليه المطلوب بكل دقة حيث ليس هناك عمل يقوم على التخمين ونبهنا من قبل مئات المرات ... لا تنجح اى مشاركة الا برفع ملف موضح عليه المطلوب بكل دقة وذلك تجنباً لعدم اهدار وقت الأساتذة دون جدوى او اهمية وبما انك لم تقم برفع ملف , فما هو السبب فى عدم استخدامك خاصية البحث بالمنتدى فبه طلبك : تحديد صف وعمود الخلية النشطة (تلوين العمود والصف باستخدام التنسيق الشرطي) كود تلوين صف نشط وهذا ايضا رابط خارجى كود لتلوين الخلية الفعالة – Active Cell

اعنقد هذا الماكرو يقوم بما تريد Sub Salim_sum() Dim Ary As Variant Dim Dic As Object Dim i%, x%, Ro%, k Dim itm If Sheets("ALL").Range("A1"). _ CurrentRegion.Rows.Count > 1 Then _ Sheets("ALL").Range("A2"). _ CurrentRegion.Offset(1).ClearContents Set Dic = CreateObject("scripting.dictionary") Ary = Array("Plus_1", "Plus_2", "Minus_1", "Minus_2", "Plus_5") For Each itm In Ary x = IIf(Sheets(itm).Name Like "P*", 1, -1) Ro = Sheets(itm).Range("a1").CurrentRegion.Columns(1).Rows.Count For i = 2 To Ro k = IIf(IsNumeric(Sheets(itm).Range("D" & i)), _ Sheets(itm).Range("D" & i), 0) If Not Dic.Exists(Sheets(itm).Range("A" & i).Value) Then Dic(Sheets(itm).Range("A" & i).Value) = x * (k) Else Dic(Sheets(itm).Range("A" & i).Value) = _ Dic(Sheets(itm).Range("A" & i).Value) + x * (k) End If Next i Next itm Sheets("ALL").Range("A2").Resize(Dic.Count) = _ Application.Transpose(Dic.keys) Sheets("ALL").Range("D2").Resize(Dic.Count) = _ Application.Transpose(Dic.Items) Set Dic = Nothing: Set Cl = Nothing: Erase Ary End Sub الملف مرفق _My_sum.xlsm

ماشاء الله هذا هو المطلوب بالفعل جزاك الله خيرا اشكرك من كل قلبى بارك الله فيك

'طباعة1.xlsm

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

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

وعليكم السلام اخي الفاضل 🙂 واهلا وسهلا بك في المنتدى 🙂 الخطأ عندك في السطر الاول ، حيث انه لما تنقر على كائن صح/خطأ ، فعلامة الصح قيمتها -1 ، وعلامة بدون صح قيمتها 0 ، فعليه يصبح الكود : If Me.dd = -1 Then ولكن ، ايش رأيك في هذ التنسيق ، بحيث بإستعمال TAB الكيبورد ننسق الكود ، فتصبح قراءة الكود سهله ، ونعرف كل مجموعة وين بدايتها ووين نهايتها : If Me.dd = -1 Then Dim t t = MsgBox("?? ??E ?E??I ?? ?UEE? ??? ?C?E C????C? ?? C??CE??E?", vbYesNo, "??? C????C? ?? C??CE??E") If t = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "C?E??C? ??? ?CE??E" Me.dd = 0 DoCmd.SetWarnings True ElseIf t = vbNo Then MsgBox "E? C?E?C?? ?? C????" End If ElseIf Me.dd = 0 Then Dim r r = MsgBox("?? ??E ?E??I ?? ?UEE? ??C?E C???? ???CE??E?", vbYesNo, "??U C????") If r = vbYes Then DoCmd.SetWarnings False DoCmd.OpenQuery "Q1" DoCmd.OpenQuery "Q2" Me.dd = 1 DoCmd.SetWarnings True ElseIf r = vbNo Then MsgBox "E? C?E?C?? ?? C???U" DoCmd.CancelEvent End If End If جعفر

وعليكم السلام ,يمكنك هذا بالدالة المعرفة payout Function payout(Value) Select Case Value Case 1 To 5 payout = "متبقى أقل من 5 أيام" Case 6 To 10 payout = "متبقى أقل من 10 أيام" Case 11 To 20 payout = "متبقى أقل من 20 يوم" Case 21 To 30 payout = "متبقى أقل من 30 يوم" Case 31 To 60 payout = "متبقى أقل من شهرين" Case 61 To 90 payout = "متبقى أقل من 3 شهور" Case 91 To 120 payout = "متبقى أقل من 4 شهور" Case 121 To 150 payout = "متبقى أقل من 5 شهور" Case 151 To 180 payout = "متبقى أقل من 6 شهور" Case 181 To 210 payout = "متبقى أقل من 7 شهور" Case 211 To 240 payout = "متبقى أقل من 8 شهور" Case 241 To 270 payout = "متبقى أقل من 9 شهور" Case 271 To 300 payout = "متبقى أقل من 10 شهور" Case 301 To 330 payout = "متبقى أقل من 11 شهر" Case 331 To 360 payout = "متبقى أقل من عام" Case Is >= 361 payout = "صلاحية أكثر من عام" Case Is < 1 payout = "إنتهت الصلاحية" End Select End Function فعليك بوضع هذه المعادلة بالخلية M13 مع السحب للأسفل =payout(L13) اصناف.xlsm

اولا : احذف هذا السطر لا تحتاجه appAccess.Visible = False ثم عدل في بعض خصائص النموذج للقاعدتين الاخرى ....... حتى تصل للنتيجة المرغوبة .....

السلام عليكم ورحمة الله ضع هذا الكود فى حدث ThisWorkbook Private Sub Workbook_SheetActivate(ByVal Sh As Object) For i = 1 To Sheets.Count Sheets(i).Range("A1").Value = i Next End Sub

بعد اذن اخي الرائد هذا الماكرو Option Explicit Sub Join_data() If ActiveSheet.Name <> "Salim" Then Exit Sub Dim i%, Dic As Object, k, my_key Set Dic = CreateObject("Scripting.Dictionary") Cells(3, "H").CurrentRegion.Clear i = 3 Do Until Cells(i, "E") = vbNullString k = Cells(i, "F") If Not Dic.Exists(Cells(i, "E").Value) Then Dic(Cells(i, "E").Value) = k Else Dic(Cells(i, "E").Value) = Dic(Cells(i, "E").Value) & "," & k End If i = i + 1 Loop Cells(3, "H").Resize(Dic.Count) = Application.Transpose(Dic.keys) i = 3 For Each my_key In Dic.keys Cells(i, "I") = Dic(my_key) & "." i = i + 1 Next my_key Set Dic = Nothing With Cells(3, "H").CurrentRegion .Interior.ColorIndex = 6 .Borders.LineStyle = 1 .InsertIndent 1 End With End Sub الملف للمعاينة مرفق talabia_SL.xlsm

حسب فهمي لطلبك: 75%.xlsx

السلام عليكم ربما لن أتمكن من تقديم شيء يذكر ولكن عسى أن يكون في هذه المشاركة ما ينفع، فمن البحث في جوجل : لديك برنامج أكسس مرتبط بـ كريستال ريبورت، أو برنامج مصمم بـ الفيجوال بيزك يخزن البيانات في قاعدة أكسس ويستخدم كريستال ريبورت لطباعة التقارير. المشكلة -كما شرحتٓها في السؤال وكما اقترح البحث- لها أسباب كثيرة، ولكن بما أن المشكلة ظهرت بعد نقل الهارد من حاسب إلى آخر فإن شيئاً مما ذكر في الحلول المختلفة لا يتصل بصورة مباشرة مع ما ظهر لديكم. ولكن كان تصفير كلمات السر هو الحل المقترح فأغلب الروابط أشارت إلى أن هذه المشكلة تحدث عند تمرير كلمة السر بين مشروع VB والكريستال ريبورت، وفي حالة برنامجكم قد لا تكون النتائج مرغوبة أومتوقعة.

أبسط طريقة لذلك هو تغيير خاصية الفورم RightToLeft وجعلها True بدلا من False كما بالصورة

هذا الكود يقوم باخفاء الاسطر التي لا توجد بها أي قيم فى العمود B و يعتمد علي تسمية مجال محدد يسمي Myrange لتحديد عدد الصفوف المطلوب ادراء هذه العملية عليها Sub hidemptyRow_basedonthiscol() ' ' hideemptyRow Macro ' Macro recorded 25-12-02 by taher to hide empty rows in aselection Application.ScreenUpdating = False Application.Goto Reference:="myrange" Myrows = Selection.Rows.Count origraw = Myrows ActiveCell.Select For i = 1 To Myrows - 1 If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = "" Then ActiveCell.EntireRow.Hidden = -1 ActiveCell.Offset(1, 0).Activate Myrows = Myrows - 1 End If Application.StatusBar = " checking ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub[/sql] HideEmptyRows.zip

لا أعلم اذا كان هذا المطلوب Education_Job.xlsx

ضع كلمة report اولا وكاتالي : Private Sub أمر4_Click() Me.sh.SourceObject = "report.rep" End Sub بالتوفيق

ماشاء الله عليك اخوي صالح ، كفيت ووفيت ، وما بقيت لي شئ اكتبه التنسيق: وذلك بإستخدام زر الـ Tab (لتحريك السطر Indenting) ، و زر Enter (للإنتقال الى السطر التالي) تنسيق وتجميع مجموعات اللـ IF مهم ، وكلما كان تنسيقك افضل ، كلما قلّت اخطاءك ، وكلما استطعت الوصوت للخطأ بسرع في الصور كود لبرنامج أحد الاعضاء (واعتذر مسبقا من صاحب الاكواد) ، لاحظ طريقة عرض الكود ، بدون تنسيق ، وصعوبة معرفة بداية ونهاية الشرط IF : قبل التنسيق وسهولة القراءة بعد التنسيق . اما الكود التالي ، فذكرني بالكاريكاتير "ابحث عن فضولي" ، وهنا نبحث عن بداية ونهاية الشرط IF : . وتم تعديل التنسيق (تغيير الكود هو للتوضيح) الى: . هناك شيئين في التنسيق ، الاول: لاحظ انه من السهل معرفة بداية ونهاية كل شرط ، وحتى الشروط المتداخلة في الشرط الاصلي ، اصبح من السهل معرفة بدايتها ونهايتها ، ونافذة الكود تخبرنا 1: على اي سطر نحن (Line, Ln) ، و 2: في اي عمود (Column, Col) ، مما يساعدنا في عملية التنسيق . ثانيا: لاحظ اني عندما اقفل الجملة الشرطية End If ، فاني اكتب تعليق خلفها ، وهذا التعليق مأخوذ من جزء من بداية الشرط IF ، هذا يسهل عليّ كثيرا معرفة بداية ونهاية الجملة الشرطية: . جعفر

وعليكم السلام غير سطر الاول في الكودالى: هذا اذا كان تنسيق (رقم السجل) رقم sf="[رقم السجل]="&[رقم السجل] اوغيره الى: sf="[رقم السجل]='"&[رقم السجل]&"'" هذا اذا كان تنسيق (رقم السجل) نص و تأكد ان اسم حقل رقم السجل على نفس اسم في النموذج

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

شفت بقى إننا أحسن من الأجانب (من غير تغيير الامتداد تم حل المشكلة بفضل المولى عزوجل)

و هذا الكود المناظر لحذف الاسطر و هنا لم يتم اختيار مجال باسم محدد ، و لكن يتم التنفيذ بناء علي اختيار المستخدم للخلاية selection Sub deleteemptyRow() ' ' deleteemptyRow Macro ' Macro recorded 19/07/2000 by taher to delete empty rows in aselection Application.ScreenUpdating = False Dim MyRow As Long, origraw As Long ' Z As String MyRow = Selection.Rows.Count origraw = MyRow ActiveCell.Select 'MsgBox MyRow For i = 1 To MyRow If ActiveCell.Value <> "" Then ActiveCell.Offset(1, 0).Activate If ActiveCell.Value = "" Then ActiveCell.EntireRow.Delete MyRow = MyRow - 1 End If Application.StatusBar = "Parsing / deleting ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub[/sql] DeleteemptyRows.zip