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

وعليكم السلام ورحمة الله تعالى وبركاته Sub test() Dim j, F, Fin&, i&, R& Dim Tb1 As Worksheet: Set Tb1 = Worksheets("control1") Dim Tb2 As Worksheet: Set Tb2 = Worksheets("تقييم عام") F = 1: j = 12 Application.ScreenUpdating = False For Fin = 10 To Tb1.Cells(Tb1.Rows.Count, "c").End(xlUp).Row If Tb1.Range("C" & Fin) <> "" Then Tb2.Range("D" & j) = Tb1.Range("C" & Fin): Tb2.Range("E" & j) = Tb1.Range("E" & Fin) Tb2.Range("F" & j) = Tb1.Range("G" & Fin): Tb2.Range("G" & j) = Tb1.Range("K" & Fin) Tb2.Range("H" & j) = Tb1.Range("L" & Fin) If F = 25 Then j = j + 8: F = 1 Else j = j + 1: F = F + 1 End If End If Next R = 1 For Col = 12 To Tb2.Range("D" & Tb2.Rows.Count).End(xlUp).Row If Tb2.Range("D" & Col) <> "" Then: Tb2.Range("C" & Col) = R: R = R + 1 If R = 26 Then: R = 1 Next Col Application.ScreenUpdating = True End Sub

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

اخي الكريم ، تم تصحيح الكود Private Sub kind_Res_AfterUpdate() If IsNull(DLookup("[txtdatay]", "Valueco", "[txtdatay] = '" & Me.kind_Res & "'")) Then MsgBox "تعبير غير صحيح", , "" End If End Sub

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

سلمك الله اخي الكريم.. الكود يعمل بكفاءة ما شاء الله.. المشكلة كانت في جهازي..في جهاز الشغل شغال زي الفل 🤩 شاكر لك وفقك الله في الدارين 🤲

وعليكم السلام ورحمة الله تعالى وبركاته تطبيق على مثالك =IF(AND(A1>=1;A1<=20);1;IF(AND(A1>=21;A1<=31);2;""))

كثيرا ما يحتاج الباحث إلى استخراج كلمات أو جمل لها لون معين للنظر فيها، أو فهرستها. وهذا الماكرو يقوم باستخراج كل العبارات الملونة بأي لون عدا اللون الأسود، ويضعها في آخر الملف مع أرقام الصفحات. فتستطيع مثلا أن تجعل كل الأعلام باللون الأحمر، والقبائل بالأخضر، والأماكن بالأزرق، وهكذا أثناء تصفحك للمستند. وفي آخر العمل تقوم باستخراج كل هذه الألوان دفعة واحدة مع أرقام صفحاتها. وهذا الماكرو: Dim char As Range For Each char In ActiveDocument.Characters If char.Font.Color <> wdColorAutomatic And char.Font.Color <> wdColorBlack Then ' إذا كان لون النص غير تلقائي أو أسود char.HighlightColorIndex = wdTurquoise End If Next Dim dic As Object Dim r As Range, k Dim s As String, p As Long Dim Tbl As Table, n As Long Set dic = CreateObject("scripting.dictionary") Set r = ActiveDocument.Content r.Collapse With r.Find .Highlight = True '.Font.ColorIndex = strFontColor Do While .Execute s = Trim(r.Text) If Len(s) > 1 Then If Not dic.Exists(s) Then Set dic(s) = CreateObject("scripting.dictionary") End If p = r.Information(wdActiveEndPageNumber) dic(s)(p) = Empty End If Loop End With If dic.Count = 0 Then Exit Sub Set r = ActiveDocument.Bookmarks("\EndOfDoc").Range Set Tbl = ActiveDocument.Tables.Add(r, dic.Count, 2) For Each k In dic n = n + 1 Tbl.Cell(n, 1).Range.Text = k Tbl.Cell(n, 2).Range.Text = Join(dic(k).Keys, "، ") Next Selection.EndKey Unit:=wdStory Beep End Sub