كل الانشطه

حبيبي لك مطلق الحرية بالتصميم والتجربة المهم أن تكون الصورة النهائية التي تؤدي الغرض المطلوب

السلام عليكم ورحمة الله وبركاته الأستاذة الافاضل الاخوة الأعزاء في منتدى اوفيسنا في قاعدة بيانات المرفقة جدول يحتوي على حقل نوعه ارتباط تشعبي من خلال الاستعلام يمكننا عن طريق دالة HyperlinkPart استخراج الرابط من الارتباط التشعبي للحقل ، المطلوب هو كيف استطيع استخراج اسم الموقع بدون رابط تشعبي يعني فقط الاسم ؟ هل هذا ممكن وكيف ؟؟؟؟؟؟ LinkName.rar

السلام عليكم كل عام و حضرتكم بخير عندي تقرير في الاكسس اريد تحويله الي ملف اكسيل ملف الاكسس https://drive.google.com/file/d/1bWTYdnA...sp=sharing مرفق ملف الاكسيل Report.xlsx

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

ما شاء الله جزاكم الله خيرا على هذا العمل الرائع والفكرة المميزة اخي @Foksh بناء على هده الفكرة القيمة قمت بتطوير الكود بحيث عند وجود أكثر من اختلاف بين القيم (قبل وبعد) يتم تمييز كل اختلاف بلون مختلف هذا فعلا يسهل جدا معرفة وتتبع الفروقات كما دكرت مع إظافة استخراج المادة التي تحتوي على الاختلاف إلى جانب الاسم والقيمة القبلية والبعدية لتوفير عرض واضح ومباشر للفروقات بالتوفيق......... نسخة معدلة من الكود لتحقيق هذا الهدف Private Sub Worksheet_Change(ByVal Target As Range) Dim r As Long, c As Long, Tbl1, Tbl2, a, b, tmp As Long, xCount As Long, key As String Dim xColor, cnt As Object, j As Long, i As Long, x As Long, ky As String Const départ = 3, ColArr = 18, début = 2, LastCol = 9, f = 9, Irow = 1 If Target.CountLarge > 1 Then Exit Sub Set cnt = CreateObject("Scripting.Dictionary") xColor = Array( _ RGB(255, 255, 0), RGB(255, 0, 0), RGB(0, 176, 80), RGB(0, 112, 192), RGB(255, 192, 0), RGB(112, 48, 160), _ RGB(255, 0, 255), RGB(0, 176, 240), RGB(146, 208, 80), RGB(255, 102, 0), RGB(204, 0, 153), RGB(0, 255, 255), _ RGB(255, 153, 204), RGB(153, 51, 0), RGB(102, 102, 255), RGB(255, 204, 153), RGB(51, 153, 102), RGB(153, 0, 0), _ RGB(0, 102, 204), RGB(204, 153, 255), RGB(255, 255, 153), RGB(204, 0, 0), RGB(0, 153, 0), RGB(0, 51, 102), _ RGB(255, 128, 0), RGB(102, 0, 102), RGB(0, 204, 204), RGB(255, 102, 102), RGB(102, 255, 102), RGB(102, 102, 153)) On Error GoTo CleanUp With Me If Intersect(Target, .Range(.Cells(départ, début), .Cells(départ + ColArr - 1, LastCol + f))) Is Nothing Then Exit Sub SetApp False .Range(.Cells(départ, début), .Cells(départ + ColArr - 1, LastCol + f)).Interior.colorIndex = xlNone With .Range("T:W"): .UnMerge: .ClearContents: End With Me.[T1:W1].Value = Array("الإسم", "المادة", "قبل", "بعد") tmp = 2: j = 0: xCount = 0 For r = départ To départ + ColArr - 1 b = .Cells(r, Irow).Value For c = début To LastCol Tbl1 = .Cells(r, c).Value: Tbl2 = .Cells(r, c + f).Value: a = .Cells(2, c).Value If IsEmpty(Tbl1) Then Tbl1 = "" If IsEmpty(Tbl2) Then Tbl2 = "" If CStr(Tbl1) <> CStr(Tbl2) Then xCount = xCount + 1 key = b & "|" & a & "|" & Tbl1 & "|" & Tbl2 If Not cnt.Exists(key) Then cnt.Add key, xColor(j Mod (UBound(xColor) + 1)) j = j + 1 End If .Cells(r, c).Interior.Color = cnt(key) .Cells(r, c + f).Interior.Color = cnt(key) .Cells(tmp, "T").Resize(1, 4).Value = Array(b, a, Tbl1, Tbl2) tmp = tmp + 1 End If Next c Next r If xCount > 0 Then .Cells(tmp, "T").Value = "إجمالي الاختلافات" .Cells(tmp, "U").Value = xCount x = 2: ky = .Cells(x, "T").Value For i = 3 To tmp If .Cells(i, "T").Value <> ky Or .Cells(i, "T").Value = "" Then If i - 1 > x Then .Range("T" & x & ":T" & i - 1).Merge x = i ky = .Cells(i, "T").Value End If Next i Else With .Range("T:W"): .UnMerge: .ClearContents: End With End If CleanUp: SetApp True Set cnt = Nothing End With End Sub Private Sub SetApp(ByVal enable As Boolean) With Application .ScreenUpdating = enable: .EnableEvents = enable: .DisplayAlerts = enable .Calculation = IIf(enable, xlCalculationAutomatic, xlCalculationManual) End With End Sub درجات المواد v4.xlsb

استخدم اوفيس 2016 64 بت وايضا اوفيس 365 64 بت دون فائدة لعمل الأكواد

كلامك وكلام الزملاء صحيح عند اتباع الخطوات الصحيحة وخاصة الجداول تسهل عملية ادخال واخراج البيانات بارك الله فيكم استاذ @ابوخليل

أيضا للأسف لا يعمل

شغال 100% شغال 100% و مع الخطأ في الأساسات .. العمل على جدولين كالعمل على جدول واحد

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

يا اخي الكود شغال لدي ولم ارفق الملف الا بعد التجربة دون جدوى ... طيب وضح هل هناك رسالة ظهرت لديك .... وهل الملف بعد فتحه طلب عملية تمكين ..؟؟؟؟؟؟؟؟؟؟

أخي منتصر شكر الله قضلك وجهدك المبارك لكن الكود لا يعمل للأسف دون جدوى

تم تعديل الكود الخاص بك بسطور بسيطة فقط جرب التعديل المرفق ‏‏القرآن الكريم 2.rar

تفضل ....................... ‏‏القرآن الكريم 2.accdb

اخي الكريم الحل يسير جدا اذا ضبطت الجداول فلست بحاجة الى اكواد فقط ستكون الاكواد مثل الموجودة حاليا في مثالك .. ماكرو او سطر بسيط

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

صحيح مافعلته ولكني اردت ان يكون النموذج list اكثر ديناميكية بحيث يمكن ان نعيد استخدامه مع اي تقرير وليس هذا التقرير فقط وذلك بتمرير اسم التقرير في معلمة OpenArgs

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

جداوله مكتملة وافية .. فقط بحاجة الى اعادة تنسيق كما ذكر اخونا @Foksh

إطلالة سريعة على هذا الموضوع قد تكون مفيده بدرجة كبيرة قد لا تتصورها : جدول بآيات القرآن الكريم كاملا.zip

رب ارزقني وعجل لماذا حذفت عمود عدد الآيات؟ ارفق تعديلك بارك الله فيك كل ما تفكر به ممكن باذن الله .. ولكن الأهم ضبط الجداول

حبيبي تم عمل الطريقة حسب ما ذكرته وأيضا دون فائدة

سيتم التجربة و تصميم الكود والمحاولة حسب الطريقة التي ذكرتها لي

الصحيح ان يكون جدول السور عبارة عن 114 سجلا فقط ( كل اسم سورة في سجل وحيد) ونضيف الى جدول الآيات حقلا معرفا لرقم السورة ثم نربط العلاقة بين الجدولين رأس لأطراف بمعرفة رقم السورة في الجدولين سبق وان عملت على قاعدة مثل هذه وما زالت الأساسات عندي للعلم يمكنك البحث بالايات وايضا الذهاب الى اول الجزء او او السورة او الى صفحة محددة

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