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

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

السلام عليكم اضع بين ايديكم هذه المعلومة حيث اخذت الفكرة من احد الاحبة في هذا المنتدى وطورتها بحيث لا تستطيع الحذف بعد ادخال البيانات والكبس على ايقونة حفظ ولكي تستطيع الحذف عملت نموذج اخر لا تستطيع الوصول اليه الا برقم سري الرقم السري 12345 جربوا الطريقة عساها تعجبكم العلم لا يحتكر delete_officna.accdb

جرب المثال المرفق ربما يساعدك Database79.accdb

كل الشكر لك استاذي العزيز سليم حاصبيا رغم اني تغلبت على المشكلة وحليتها ولكن ليس بنفس طريقتك فطريقتك سهلة للغاية مقارنة بالطريقة التي حللت بها المشكلة مرفق ملف الحل كما طلب أخي القدير الاستاذ مهند محسن List of Services.xlsx

ممكن ان يكون الحل هنا ايضاً three_cond_format.xlsx

العفو اخى حربى وبلاش استاذى فلست سوى طالب علم شوف التعديل ده واخبرنا بالنتيجه بالتوفيق اخى SuperMarketSals11(1).rar

ممكن عن طريق بحث بمعيار التاريخ وايضا ممكن في الاستعلام شاهد المثال المرفق Database79.accdb كلا الطريقتين تؤدي للنتيجة اخي احمد اعتذر لم اشاهد ردك

وعليكم السلام اخى الفاضل قم بعمل استعلام لهذا الجدول وفى حقل التاريخ واكتب فى حقل المعيار تحته date() سيتم تصفيه الاستعلام على مدخلات تاريخ اليوم فقط بالتوفيق

وعليكم السلام هل هذا ما تريد شوف واخبرنا تقبل تحياتى SuperMarketSals11.rar

لمراعاه كافة الاحتمالات لكون معيار التاريخ يتأثر بطريقة الكتابة واسلوب التاريخ في النظام بالتوفيق اخي ليث والشكر لله سبحانه

السلام عليكم اولا : اهلا فيك في اوفيسنا ثانيا: عمل قاعدة البيانات يتطلب منك بالاول انشاء الجداول لكي يتم بناء قاعدة البيانات عليها. ثالثا" بالنسبة لرقم الجوال يمكن تققيده من خلال قناع الادخال (00000000000) او من خلال كود يضع بعد التحديث او من خلال قاعدة التحقق من الصحة. ملاحظة : بعض الحقول مثل (المؤهل العلمي والتخصص) من الافضل والاجمل ان تكون قائمة منسدلة . - عملت لك جدول عدد /2 بالمرفق قم بالتعديل عليها حسب منتطلبات عملك تحياتي test-1.rar

السلام عليكم ستجد في المرفق استعلام مطابقة المتكررات وحذف المكرر، أعتذر لتأخري باستكمال الاستعلام. أرجو أن يكون هذا ما تبحث عنه. QueryDeleteDuplicate.accdb

السلام عليكم ورحمة الله وبركاته لقد أنشأت برنامج بسيط وجمعت به الأكواد التي نسنتخدمها باستمرار وصممته بحيث تكون الواجهة عبارة عن شاشة يتم تجميع بها الأكواد المراد نسخها الي شاشة الفيجوال بيسك لمشاهدة كيف يعمل البرنامج من هذا الرابط بنك الأكواد - demo-24-4-2019.accdb

استاذي الفاضل احمد الفلاحجي جدا ممنون منك يا طيب نعم هذا هو المطلوب الله يبارك فيك ويحفظك يا طيب جزاك الله خيرا

اخى الفاضل سعر البيع سوف يظهر بعد ما تختار الحجم لان السعر مرتبط ببيان الصنف والحجم ولا انا فاهم غلط جرب مره اخرى ووافنا بالنتيجه بالتوفيق

العفو اخى يوسف بلاش استاذ فلا تناسبنى فلست سوى طالب علم انظر لهذا التعديل لعله يناسبك مبدئيا الى انا يشاركنا احد اخواننا واساتذتنا الافاضل حاولت اعملك الرصيد التراكمى لكن موصلتش تقبل تحياتى وتمنياتى لك وللجميع بالتوفيق موازنة 2020(3).accdb

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

باذن الله تعالى

اخي واستاذي حسين اشكرك على مجاملتك الرقيقة ومشاعرك الطيبة

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

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

السلام عليكم ورحمة الله وبركاته وبعد ... عزيزي العضو السائل عن الشريط الموجود بالبرنامج الموضح صورته بالمشاركة الأولى ... الحل بسيط جدا هو أن يكون لديك نسخة من البرنامج من إصدار أوفيس إكس بس أو 2003 وتعمل عليها شريط القوائم المطلوب ومن ثم تقوم باستيراد كل الكائنات للقاعدة من البرنامج الذي تعمل عليه ومن ثم تحويله للعمل على أي إصدار أحدث ...ففي القاعدة المرفقة لاحظ القوائم ولا يوجد أي نماذج لأن هذه هي القاعدة الفارغة التي أحتفظ بها بإصدار قديم mdb أقوم بفتحها على الأوفيس إكس بي وأقوم باستيراد النموذج أو التقرير الذي أحتاج ربطه على شريط القوائم كما ترى في الصورة بمسمى محدد ثم أقوم بحفظ الملف ونسخه وتسميته بأي إسم آخر غير القاعدة التي أخصصها لعمل شريط القوائم ثم أقوم بفتح الملف الجديد بأي اصدار حديث و أقوم باستيراد كل محتويات الملف الأصلي للبرنامج ثم أقوم بحفظه بأي صيغة أحتاجها سواء مفتوحة أو مغلقة كما ترى في الصورة التالية ويمنني معاونة حضرنك في عمل شريط قوائم للبرنامج الخاص بك بشرط إرسال البرنامج في صيغة mdb وبيان بالشريط كما تتخيله وحاضرين سيتم تلبية طلبك ولو شئت ممكن المراسلة على الخاص لحفظ حقوق تصميمك و جزاكم الله خيرا

اهلا وسهلا استاذي ابو بسملة الحقيقة الطريقة التي استخدمها تختلف قليلا عن هذه الطريق وان كانت تشترك معها في استخدام اكواد او وسوم xml الطريقة متعبة وتحتاج الى معرفة بهذة الوسوم او على الاقل المعرفة بلغة ترميز النصوص المتشعبة html الخاصة ببناء صفحات الانترنت لوجود تشابه بينهما طريقتي باختصار كتابة الوسوم ووضع id لكل امر اما طريقة تنفيذ الامر فعن طريق وحدة نمطية مع ان النتيجة رائعة الا ان الطريقة متعبة جدا وسوف احاول بعون الله ان اضع موضوع يشرح الطريقة واعتذر اذاكان الرد غير مفيد واستعير عبارة جميلة لاخي واستاذي الفاضل @essam rabea "انا راجل عجوز" فانا فعلا رجل عحوز والشروحات مرهقة جدا

ممكن تجاوز الرسالة بصائد الأخطاء او استثناء حقل الترقيم التلقائي

المشكلة في حقل الترقيم التلقائي .

Dim ctl As Control For Each ctl In Me.Controls If ctl.ControlType = acTextBox or ctl.ControlType = acComboBox Then If ctl.Value <> "" Then ctl = "" End If End If Next ctl عن أذن أخي وحبيبي أحمد غير كلمة and إلى or كما في المثال أعلاه

فكرة رائعة جزاك الله خيرآ

وعليكم السلام-تفضل لك ما طلبت Classeur4.xlsx

فعلا اخي دققت ورايت كل شيء رائع سلمت يداك على هذا العمل الرائع وجزاك الله افضل الجزاء واعتذر للاطالة ولتعبك معي

بسم الله الرحمن الرحيم اليكم ملف فيه شيت يحتوي على تقرير مستخرج من شيت آخر على حسب التاريخ وكود لطباعة مجموعة من التقارير تلقائيا مرة واحدة قد يستفاد من معادلات الترحيل ايضاَ جدول زمني مع طباعة تلقائية.xlsm

دائما مبدع و متألق اخي خالد اسأل الله لك التوفيق و منكم ما زلنا نتعلم الكثير شكرا لك

مشكور اخي خالد نجح الكود ويعمل بشكل جيد

جزاك الله خيرا اخى واستاذى خالد نفسى افهم لما تم وضع السلاش هكذا ؟ DoCmd.ApplyFilter , "[Date of invoice]=" & Format([tx2], "\#mm\/dd\/yyyy\#")

الأمر ليس بالسهل او الهين فلا تستعجل واصبر

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

تم تحرير كود لهذا الغرض Option Explicit Sub MY_Data_New() Application.ScreenUpdating = False Dim SH_from As Worksheet Dim T As Worksheet Dim rg_to_Patse As Range Dim Rt%, MY_max%, ro%: ro = 4 Set T = Sheets("Total") Set rg_to_Patse = T.Range("A3").CurrentRegion Rt = rg_to_Patse.Rows.Count If Rt > 1 Then Set rg_to_Patse = rg_to_Patse.Offset(1).Resize(Rt - 1) Else Set rg_to_Patse = T.Range("B4").Resize(, 5) End If rg_to_Patse.Clear For Each SH_from In Sheets If SH_from.Name <> T.Name Then MY_max = Application.Max(SH_from.Range("A:A")) SH_from.Cells(3, 1).Resize(MY_max, 6).Copy With T.Cells(ro, 1) .PasteSpecial (xlPasteValues) .PasteSpecial (xlPasteFormats) End With ro = ro + MY_max End If Next SH_from With T.Range("A4").Resize(ro - 4, 6) .Sort key1:=Range("b3"), Header:=1 .Value = .Value End With Application.ScreenUpdating = True arraNge_all End Sub '+++++++++++++++++++++++++++++++++++ Sub arraNge_all() Application.ScreenUpdating = False Dim nro% Dim MM% nro = Cells(Rows.Count, 1).End(3).Row Dim color_rg As Range For MM = 4 To nro If Range("a" & MM).Interior.ColorIndex <> xlNo Then If color_rg Is Nothing Then Set color_rg = Range("a" & MM).Resize(, 6) Else Set color_rg = Union(color_rg, Range("a" & MM).Resize(, 6)) End If End If Next color_rg.Copy Range("a" & nro + 1) color_rg.EntireRow.Delete Range("A4", Range("A3").End(4)).Formula = _ "=IF(B4="""","""",MAX($A$3:A3)+1)" Range("A3").CurrentRegion.Value = _ Range("A3").CurrentRegion.Value Range("A4").Select Set color_rg = Nothing Application.ScreenUpdating = True End Sub الملف من جديد M_data_new_SA.xlsm

وعليكم السلام جرب كالتالى ان شاء الله يظبط معك واخبرنا بالنتيجه "[op_date]=# " & forms!sale_center_search!op_date_search & "#" بالتوفيق ان شاء الله

أ.يوسف السيد مش فاهم قوى بس قلت أشارك وخلاص .. هذا بالنسبة للسؤال الأول ( ستجد إستعلام جديد إسمه Budget_2 جايز يكون المطلوب ) .. أما الثانى فلو تضيف شاشة الإدخال يكون أفضل. موازنة 2020.accdb

الحلقة الرابعة: التعامل مع القائمة المنسدلة في صفحة ويب سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التحكم الكامل في القائمة المنسدلة داخل الأداة في صفحة ويب لقد قمت بتطبيق هذا الدرس على موقع الفايس بوك لأن به قائمة منسدلة الخاصة بالأشهر و لها خاصية: Id=month لهذه القائمة عمودين عمود مخفي و هو يمثل القيمة الحقيقة به أرقام من 0 إلى 12 و عمود ظاهر به أسماء الأشهر 1- كود حساب عدد عناصر القائمة: MsgBox Me.WebBrowser3.Document.getElementById("month").Length 2- كود معرفة القيمة الحقيقية للعنصر: من المعلوم أن القائمة المنسدلة يمكن أن يكون بها أكثر من عمود يعني ممكن تصبح القيمة الظاهرة تختلف عن القيمة الحقيقية MsgBox Me.WebBrowser3.Document.getElementById("month").Value 3- كود استخراج ترتيب القيمة الظاهرة: استخراج ترتيب القيمة الظاهر ضمن عناصر القائمة المنسدلة MsgBox Me.WebBrowser3.Document.getElementById("month").selectedIndex 4- كود استخراج القيمة الظاهرة: MsgBox Me.WebBrowser3.Document.getElementById("month").Item(Me.WebBrowser3.Document.getElementById("month").selectedIndex).innerText 5- إظهار جميع عناصر القائمة: Dim x As String Dim i As Integer For i = 1 To Me.WebBrowser3.Document.getElementById("month").Length x = x & " - " & Me.WebBrowser3.Document.getElementById("month").Item(i - 1).innerText Next i MsgBox x 6- اختيار عنصر من القائمة باستخدام رقمه الترتيبي: هنا وضعت القيمة تساوي 5 معناه سوف يتم اختيار العنصر رقم 5 و هو مايو Me.WebBrowser3.Document.getElementById("month").selectedIndex = 5 7- تغيير نص قيمة في العمود الظاهر من القائمة: سوف يتم تغيير كتابة أفريل في القائمة إلى أوفيسنا Me.WebBrowser3.Document.getElementById("month").Item(4).innerText = "أوفيسنا" 8-تغيير قيمة في العمود المخفي من القائمة: Me.WebBrowser3.Document.getElementById("month").Item(4).Value = "15" قبل البداية في تطبيق درس اليوم اضغط على زر فتح صفحة الفايس بوك لتظهر الصفحة أمامك webbroser.rar

الحلقة الثالثة: التعامل مع كائنات صفحات HTML و إرسال و إستقبال البيانات سوف نتطرق في هذه الحلقة إلى الأكواد التي تمكننا من التعامل مع كائنات صفحات الويب و إرسال و إستقبال البيانات منها و إليها. هنالك ثلاث كائنات سوف نتعامل معها فيما يخص إرسال و إستقبال البيانات و هي مربع نص و القائمة المنسدلة و الجداول لأن لكل كائن أكواده الخاصة. لكن قبل البدئ يجب التطرق إلى كيفية إستخراج الاسم المميز للعناصر ID أو NAME من أجل التعامل معها من خلال نموذج الأكسس. هناك عناصر لها ID و أخرى لها NAME و هناك لها الخاصيتين معا و هناك عناصر ليس لها NAME أو ID خطوات استخراج ID أو NAME موجود في هذه الصور: 1- كود إرسال قيمة لمربع نص في صفحة ويب: في هذا المثال سوف نستخدم صفحة غوغل و نقوم بإرسال كلمة أوفيسنا إلى من مربع بحث غوغل Me.WebBrowser3.Document.all("q").Value = "أوفيسنا" أو Me.WebBrowser3.Document.all("q").innerText = "أوفيسنا" أو Me.WebBrowser3.Document.Forms(0).q.Value = "أوفيسنا" أو Me.WebBrowser3.Document.getElementById("q").innerText = "أوفيسنا" Document : هي كل محتويات الأداة الموجوة في صفحة الويب من أزرار و مربعات و نصوص ...... 2- كود إستقبال قيمة من مربع نص في صفحة ويب: سوف نقوم باستخراج القيمة المكتوبة في مربع نص البحث لموقع غوغل MsgBox Me.WebBrowser3.Document.all("q").Value أو MsgBox Me.WebBrowser3.Document.all("q").innerText أو MsgBox Me.WebBrowser3.Document.Forms(0).q.Value أو MsgBox Me.WebBrowser3.Document.getElementById("q").innerText 3- كود الضغط على زر أمر: سوف نقوم بإرسال نقرة على زر فتح شاشة الدخول لجمايل Me.WebBrowser3.Document.Forms(0).gb_70.Click أو Me.WebBrowser3.Document.all("gb_70").Click أو Me.WebBrowser3.Document.getElementById("gb_70").InvokeMember ("Click") webbroser.rar ماذا تقصد بتنزيل البيانات ؟ هل استخراج قيم أم تنزيل ملفات

في المرفقات مثال بسيط بناء على طلبكم يقبل البحث بهمزة وبدون والالف المقصورة مع اليا والتاء المربوطة مع الهاء Database78.accdb

يا خرابي ، علاقتنا وصلت لهذه الدرجة 😱🥵😭 العفو ، انا امزح معاك ، واعرف انها خطأ مطبعي 🙂 السبب انك تستخدم ملف MDW هو للتحكم بالمستخدمين ، وابعاد المتطفلين (الغير محترفين 🙂 ). اعمل التالي لوسمحت ، على زر ، في اي برنامج عندك ، اكتب : msgbox currentuser والنتيجة ستكون Admin . هذا معناه ، ان اذا البرنامج غير محمي بملفه الخاص MDW ، فالاكسس سيقرأ اسم المستخدم من الملف الاصل System.MDW . لهذا السبب ، اذا المتطفل اخذ البرنامج ، وحاول يفتحه في على كمبيوتره (بدون وجود ملف MDW ولا المختصر الذي يقرا من MDW ، واستطاع ان يفك ارتباطه من الـ MDW) ، فتلقائيا يجب ان لا يشتغل البرنامج ، وذلك بإتباع : . لهذا السبب ، ولأنه ببساطه للذي يفهم شوي في الاكسس ، يقدر يتخطى هذا الملف ، وللعلم فالحماية هذه عن طريق MDW يعتبرها المحترفين "مجرد قفل صغير" وليس قفلا حقيقيا يحمي البرنامج ، ولهذا السبب ازالته المايكروسوفت من اصدارات 2007 فما فوق (على حد تعبيرهم) 🙂 جعفر

من خلال محرر الاكواد يتم طبع السطر الاتى DoCmd.RunCommand acCmdWorkgroupAdministrator تم استدعاءه المستخدمين من واقع الملف الناتج الذى يحمل امتداد MDW من خلال الدخول الى محرر الاكودا فى الجزء Immediate كما فى الصورة بعد الضغط من لوحة المفاتيخ على زر الادخال Enter يتم فتح مربع حوارى ومن خلال اختيار الاستعراض يتم تحديد مكان الملف دى الطريق الصعبة الطريقة التى افضلها شورت كت للقاعدة ووضع هذا السطر فى الــ Target "C:\Program Files (x86)\Microsoft Office\root\Office16\MSACCESS.EXE" "D:\xxx\zz.mdb" /WRKGRP "C:\Secur\اسم الملف.mdw" مع مراعاة التأكد من المسار لكل من نسخة الاوفيس لملف الاكسيس مساار قاعدة البيانات مسار ملف mdw شوف خذ نسخة من قاعدة لديك وقم بتغيير اللحقة فيها من Accdb الى mdb وقم بعمل كل الخطوات وانظر لترى النتيجه هههههههههههه ممكن نضحك على الاكسس يا سيدى علشان خاطر عيونك يا سلام

أهلين أستاذ جعفر كل عام و أنت بخير إن شاء الله لم أقرأ كل الردود لكن حسب الردود و الموضوع الذي قرأته و كأن ميكروسفت تريد القضاء على الأكسس بطريقة أو أخرى فأي ميزة ممتازة فيه يتم حذفها مثلها مثل أذونات المستخدمين في 2003 و النسخة الجديدة لا توجد بها بالرغم من أنها تمثل نظام حماية ممتاز المهم: نحن نستخدم 2010 و هذه الميزة متوفرة حاليا حسب الفديو الموجود في الرابط لكن ما ينقصنا لتجربة هذه التقنية هي طريقة الحصول على حساب في Access Services و لا أدري هل هي مجانية أم بمقابل مادي و أظن أنه عليا أن نعد العدة لكي نرحل إلى فجوال ستيديو قبل ما نصطدم بميكروسفت تحذف VBA من الأكسس

يمكنك النظر الى الصورة المرفقة والغاء كافة العلامات وتطبيق اي نموذج بحث 🔍

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته كل عام أنتم جميعا بكل خير كنت قد صممت ملفا للبحث في القرآن الكريم به دالة لكل ما تريد وهو تجاهل الهمزات والتشكيل والتاء المربوطة والياء المتطرفة لاحظ استعمالها في الفلتر كما أنه يمكن استعمالها في الاستعلام أو التقرير ربما يفيدك أخي الكريم ويفيد كل راغب في العلم النافع ولا تنسوني من صالح دعائكم البحث في القرآن الكريم بدون تشكيل.rar

استخدم هذا DCount("OrderID", "tblorders", "[OrderDate] =#" & Format(Me.OrderDate.Value, "mm/dd/yyyy") & "#")

بسم الله الرحمن الرحيم الحمد لله رب العالمين والصلاة والسلام علي سيدنا محمد النبي الامين وعلي من سار بهديه الي يوم الدين اما.....بعد في موضوع لي سابق طرحت كود تفقيط لتحويل الأرقام من أرقام إلى كتابة لكن (إنجليزي) http://www.officena.net/ib/index.php?showtopic=45828&hl= اليوم سأطرح لكم كود تفقيط أو ملف جاهز لإضافته في الفيجول بيسك بكل سهوله وإستخدامه كداله كاي داله أساسيه في الإكسيل طريقة إضافة ملف التفقيط : حمل ملف التفقيط من المرفقات وافتح ملف الإكسيل وإظغط على Alt+F11 وبعدها ستفتح لك صفحة الفيجول بيسك إذهب إلى File وبعدها Import File وضع الملف وأغلق الفيجول بيسك في الإكسيل إذهب الداله المعرفة من قبل المستخدم وستجدها NoToTxt وتابع الإدخالات كما في الصور المرفقة المميز في هذا التفقيط , يمكنك إضافة أي عمله مثل ريال"هلله_جنيه"قرش_دينار"فلس ملف تفقيط + إكسل شيت.rar

السلام عليكم 1. من المعروف ان تنسيق النص في مربع القائمة ListBox هو من اليسار الى اليمين ، مشكلة كانت تصادفني دائما ، وهو تنسيق القيم في مربع القائمة لتكون من اليمين الى اليسار بالنسبة للغة العربية (طريقة تغيير مربع القائمة الى مربع تحرير ونص ، ثم عمل التنسيق عليه من اليمين الى اليسار ، ثم اعادته الى مربع قائمة لا يعمل معظم الوقت) ، موقع http://www.lebans.com والذي يحتوي على مالذ وطاب عنده طريقه لهذا التنسيق: http://www.lebans.com/justicombo.htm كذلك. 2. ونفس المشكلة مع موضوع تنسيق الشجرة TreeView من اليمين الى اليسار. النتيجة: و وطريقة العمل ، يوضع هذا الكود في وحدة نمطية: Option Compare Database Option Explicit #If VBA7 And Win64 Then '64 bits Public Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long) As Long Public Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare PtrSafe Function InvalidateRect Lib "user32" (ByVal hwnd As LongPtr, lpRect As Long, ByVal bErase As Long) As Long Public Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr Public Declare PtrSafe Function GetFocus Lib "user32" () As LongPtr Public Declare PtrSafe Function GetWindow Lib "user32" (ByVal hwnd As LongPtr, ByVal wCmd As Long) As LongPtr Dim hwnd As LongPtr #Else '32 bits Public Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Public Declare Function InvalidateRect Lib "user32" (ByVal hwnd As Long, lpRect As Long, ByVal bErase As Long) As Long Public Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long Public Declare Function GetFocus Lib "user32" () As Long Public Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Dim hwnd As Long #End If Public Const GW_CHILD = 5 Public Const WS_EX_LAYOUTRTL = &H400000 Public Const GWL_EXSTYLE = (-20) Function RTL_Set(frm As Form, ctl As Control) Dim varHwnd As Variant Dim OldLong As Long frm.SetFocus ctl.SetFocus varHwnd = GetFocus() OldLong = GetWindowLong(varHwnd, GWL_EXSTYLE) SetWindowLong varHwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL InvalidateRect hwnd, 0, False End Function Function RTL_SetTree(frm As Form, ctl As Control) Dim OldLong As Long OldLong = GetWindowLong(ctl.hwnd, GWL_EXSTYLE) SetWindowLong ctl.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL InvalidateRect hwnd, 0, False End Function ' ' From http://www.microsoft.com/middleeast/msdn/faq.aspx ' 'Place OnLoad of the Form ' Dim OldLong As Long 'For Form ' OldLong = GetWindowLong(Me.hwnd, GWL_EXSTYLE) ' SetWindowLong Me.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For List ' OldLong = GetWindowLong(List1.hwnd, GWL_EXSTYLE) ' SetWindowLong List1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For The StatusBar ' OldLong = GetWindowLong(StatusBar1.hwnd, GWL_EXSTYLE) ' SetWindowLong StatusBar1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For TreeView ' Dim nodX As Node ' Set nodX = TreeView1.Nodes.Add(, , "R", "Root") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C1", "Child 1") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C2", "Child 2") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C3", "Child 3") ' Set nodX = TreeView1.Nodes.Add("R", tvwChild, "C4", "Child 4") ' nodX.EnsureVisible ' OldLong = GetWindowLong(TreeView1.hwnd, GWL_EXSTYLE) ' SetWindowLong TreeView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For ListView ' OldLong = GetWindowLong(ListView1.hwnd, GWL_EXSTYLE) ' SetWindowLong ListView1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For ProgressBar ' ProgressBar1.Value = 50 ' OldLong = GetWindowLong(ProgressBar1.hwnd, GWL_EXSTYLE) ' SetWindowLong ProgressBar1.hwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False 'For ToolBar ' mhwnd = GetWindow(Toolbar1.hwnd, GW_CHILD) ' OldLong = GetWindowLong(mhwnd, GWL_EXSTYLE) ' SetWindowLong mhwnd, GWL_EXSTYLE, OldLong Or WS_EX_LAYOUTRTL ' InvalidateRect hwnd, 0, False في اسفل الكود انا تركت الكود لبقية الاشياء اللي يمكن عملها من اليمين الى اليسار. اما تنفيذ التنسيق لمربع القائمة ، فهو وضع هذا الكود عند تحميل النموذج الذي يحتوي على هذا المربع (وهنا اسم حقل مربع القائمة هو List0_RTL ) : 'ListBox RTL Call RTL_Set(Me, List0_RTL) وتنسيق الشجرة ، فهو وضع هذا الكود عند تحميل النموذج الذي يحتوي على الشجرة (وهنا اسم الشجرة هو TreeView1) : 'TreeView RTL Call RTL_SetTree(Me, TreeView1) وللأمانة العلمية ، فاني استخدم قاعدة البيانات التي وضعها الاخ محمد في الرابط: http://www.officena.net/ib/index.php?showtopic=60781 جعفر تعديل 1: 18-11-2021 ، جعل البرنامج يعمل على النواتين 32بت و 64 بت 54.RTL_TreeView_ListBox_32bits_n_64bits.accdb.zip

وعليكم السلام أخوي ابورحيل البحث في المنتدى سيوصلك ، بالاضافة الى روابط اخرى ، الى هذا الرابط: http://www.officena.net/ib/topic/61106-هدية-من-اليمين-الى-اليسار،-مربع-القائمة-listbox-والشجرة-treeview/ جعفر