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

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

السلام عليكم اخواني الكرام قمت بتصميم هذا البرنامج لتصميم وطباعة الباركود فاعطوني رأيكم دام فضلكم اضف الخطوط الموجودة في المرفق الى مجلد الخطوط وشغل البرنامج 1- يمكنك تصميم اللصاقة المناسبة من التقرير 2- يمكن طباعة عدد محدد من اللصاقات ومن اي لصاقة يبدأ الطباعة 3- يمكن اختيار اتجاه الطباعة افقي او عمودي 4- يمكنك تحديد هوامش ورقة a4 حتى تتناسب مع اللصاقة المطلوبة تحياتي للجميع من فضلكم ليس هناك داعى لعمل اقتباس عند الرد فهذا يقوم بدوره بتشتيت المطلع والباحث عن نفس الموضوع مستقبلاً , باركود.rar

السلام عليكم ورحمة الله تعالى وبركاته من منا يمل من كثرة استخدام الرسائل مثلى ويظل يفكر فى كل مرة كيف سيكتب الكود المناسب الان موديول واحد به الحل النهائى المرن فى التعامل مع الرسائل وحتى لا ننسي الفضل لاصحاب هذا العمل الحقيقين الاستاذ @أبو هادي >>----> تعريب الصندوق الاستاذ @ابوخليل >>----> تعريب الصندوق الاستاذ @أبو آدم >>----> تلوين محتوى الرسالة هذا المثال الذى اهديه لكم هو خلاصة دمج الاكواد المستخدمة من كل معلم من هؤلاء العظماء مع بعض التطوير البسيط الذى لا يذكـر اصلا والذى فقط يضفى المرونة فى سهولة استدعاء الكود داخل اى نموذج مع مرونة التغيير فى اضافات الرسالة او عنوان الرسالة حسب متطلبات المبرمج - ملاحظة للمرة الاولى احاول التوفيق بين الأكواد التى تعمل على كل من النواتين 64 بيت والـ 32 بيت ولا اعلم صراحة هل وفقت فى ذلك ام لا شرح سريع لمحتوى المثال المرفق اولا أكواد الموديول هذا الكود للاستاذ الجليل الاستاذ @أبو آدم '---- اللألوان -------------------------------------------------------------------------------- #If Win64 Then Declare PtrSafe Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Declare PtrSafe Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long #Else Declare Function GetSysColor Lib "user32" (ByVal nIndex As Long) As Long Declare Function SetSysColors Lib "user32" (ByVal nChanges As Long, lpSysColor As Long, lpColorValues As Long) As Long #End If Public DefaultColour As Long Public Const COLOR_WINDOWTEXT As Long = 8 Public Const CHANGE_INDEX As Long = 1 طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج DefaultColour = GetSysColor(COLOR_WINDOWTEXT) ' تخزين لون ثيم النظام الافتراضي SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed ' اضبط لون ثيم النظام على اللون الأحمر MsgBox "you welcome in officena forums", , "welcome" ' كود الرسالة SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, defaultColour ' استعادة القيمة الافتراضية بعد اغلاق الرسالة الشرح تفصيلا لكل سطر بالكود DefaultColour = GetSysColor(COLOR_WINDOWTEXT) هذا السطر لحفظ تنسيق الالوان المستخدم فى ثيم الويندوز ثم SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, vbRed هذا يغير اعدادت ثيم الويندوز لتغير لون الكتابة الى اللون الاحمر طبعا يمكن تغيير اللون كيفما تريد بتغير vbRed الى ما تريده انت ثم نكتب الرسالة داخل الكود المخصص لها مثلا MsgBox "you welcome in officena forums", , "welcome" ثم بعد عرض الرسالة العودة مرة اخرى للون المفضل لثيم الويندوز والذى اختفظنا به فى الجزء الاول من الكود SetSysColors CHANGE_INDEX, COLOR_WINDOWTEXT, DefaultColour وبهذا انتهى جزء تلوين محتوى النص للرسالة الجزء الثانى من الكود داخل الموديول والخاص بتعريب الأزرار الاستاذ @ابوخليل / الاستاذ @أبو هادي #If Win64 Then Declare PtrSafe Function GetCurrentThreadId Lib "kernel32" () As Long Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare PtrSafe Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Declare PtrSafe Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare PtrSafe Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long #Else Declare Function GetCurrentThreadId Lib "kernel32" () As Long Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Declare Function SetDlgItemText Lib "user32" Alias "SetDlgItemTextA" (ByVal hDlg As Long, ByVal nIDDlgItem As Long, ByVal lpString As String) As Long Declare Function SetWindowsHookEx Lib "user32" Alias "SetWindowsHookExA" (ByVal idHook As Long, ByVal lpfn As Long, ByVal hmod As Long, ByVal dwThreadId As Long) As Long Declare Function UnhookWindowsHookEx Lib "user32" (ByVal hHook As Long) As Long #End If Private m_hHook As Long Const IDOK = 1 Const IDCANCEL = 2 Const IDABORT = 3 Const IDRETRY = 4 Const IDIGNORE = 5 Const IDYES = 6 Const IDNO = 7 Const IDCLOSE = 8 Const IDHELP = 9 Const WH_CBT = 5 Const GWL_HINSTANCE = (-6) Const HCBT_ACTIVATE = 5 Public Sub MessageBoxFullArabicButtons(hwndThreadOwner As Long) Dim hInstance As Long Dim hThreadId As Long hInstance = GetWindowLong(hwndThreadOwner, GWL_HINSTANCE) hThreadId = GetCurrentThreadId() m_hHook = SetWindowsHookEx(WH_CBT, AddressOf MsgBoxHookProc, hInstance, hThreadId) End Sub Private Function MsgBoxHookProc(ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long If uMsg = HCBT_ACTIVATE Then SetDlgItemText wParam, IDOK, "موافق" SetDlgItemText wParam, IDCANCEL, "إلغاء" SetDlgItemText wParam, IDABORT, "إحباط" SetDlgItemText wParam, IDRETRY, "إعادة" SetDlgItemText wParam, IDIGNORE, "تجاهل" SetDlgItemText wParam, IDYES, "نعم" SetDlgItemText wParam, IDNO, "لا" SetDlgItemText wParam, IDCLOSE, "إغلاق" SetDlgItemText wParam, IDHELP, "مساعدة" UnhookWindowsHookEx m_hHook End If MsgBoxHookProc = False End Function الجزء التالى هو بناء كود عام للرسالة حتى يسهل استخدامه باستدعائه بكل سهولة فى جميع نماذج البرنامج Public Function MyMesg(Mesgtxt As String, _ Optional ByVal Buttons As VbMsgBoxStyle = vbOKOnly, _ Optional ByVal Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا", _ Optional ByVal HelpFile As Variant, _ Optional ByVal Context As Variant) As VbMsgBoxResult MessageBoxFullArabicButtons Application.hWndAccessApp MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title) End Function نلاحظ الاتى بوجه عام هذا الكود تم تصميمه على ان يكوم اقتراضيا بهذا الشكل الرسالة بسيطة تحتوى على زر امر واحد Buttons As VbMsgBoxStyle = vbOKOnly عنوان الرسالة الإفتراضى Title As String = "تطوير صندوق الرسائل العربى من منتديات اوفيسنا" الجزء من الكود هذا MessageBoxFullArabicButtons Application.hWndAccessApp الذى يستدعى تعريب الازرار السطر الاخير البناء الطيعى لتكوين كود الرسالة بالاضافات التى يفضلها المبرمج MyMesg = MsgBox(Mesgtxt, Buttons + vbMsgBoxRtlReading + vbMsgBoxRight + vbDefaultButton1, Title) طريقة استخدام الكود بالاستدعاء داخل اى مكان بالبرنامج MyMesg "منتديات أوفيسنا ترحب بكم" لتغيير العنوان الافتراضى MyMesg "منتديات أوفيسنا ترحب بكم",,"العنوان الجديد كما تريد" استخدام الاضافات لتغيير الازرار مثلا MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo مع عنوان مخصص MyMesg "هل أعجبتك هذه الترجمة و التعديلات والأفكار؟", vbYesNo,"عنوان جديد" والان وصلنا الى نهاية الموضوع اسأل الله تعالى ان يرزق اساذتنا العظماء الذين كان لهم الفضل فى هذا الموضوع البركة فى العمر والعلم والرزق والاهل والولد اللهم اغفر لهم ولوالديهم واللهم احسن اليهم كما احسنوا هم الينا اللهم تقبل اعمالهم يارب العالمين فى موازين اعمالهم وضاعف حسناتهم و الاجر اضعافا مضاعفة يارب العالمين اللهم ارفع درجاتهم فى أعلى درجات الجنان ودرجاتهم والديهم يارب العالمين امين امين امين Full Arabic Message Box.accdb Full Arabic Message Box.mdb

عمل رائع استاذ محمد بارك الله فيك ولإثراء الموضوع هذا حل اخر بدون اكواد ساقية.xls

جرب الكود التالي ، اعتقد انه يمكن اختصاره بعض الشيء ، و لكن اتصور انه يؤدي المطلوب اولا ظلل الخلايا المطلوب تحليلها ثم شغل الكود و قم باختباره ملاحظة بعد النشر : وضعت الوان مختلفة حيث لم انتبه للون الاصفر و ووضعت بدلا منه اخضر ، يمكنك تعديله كما تشاء علما بان كود اللون الاصفر 65535 Sub Color_Dubplicatesl() ' color duplicates hzl adn vl as requested by youssef Atta on 14 june Dim myrow, mycol As Integer mycol = Selection.Columns.Count myrow = Selection.Rows.Count Selection.Interior.ColorIndex = xlNone '================= ' Hzl Dubplicate For i = 0 To myrow - 1 For j = 0 To mycol - 1 If Not IsNull(ActiveCell.Offset(i, j).Value) And ActiveCell.Offset(i, j).Value <> "" Then If IsNumeric(ActiveCell.Offset(i, j).Value) Then For k = j + 1 To mycol - 1 ' compare this col If ActiveCell.Offset(i, j).Value = ActiveCell.Offset(i, k).Value Then ActiveCell.Offset(i, j).Cells.Interior.Color = 255 ' red ActiveCell.Offset(i, k).Cells.Interior.Color = 255 ' red Exit For End If Next k ' compare this col End If ' if numeric End If ' not if null Next j Next i '============== ' Vl Duplicates '================= For i = 0 To mycol - 1 For j = 0 To myrow - 1 If Not IsNull(ActiveCell.Offset(j, i).Value) And ActiveCell.Offset(j, i).Value <> "" Then If IsNumeric(ActiveCell.Offset(j, i).Value) Then For k = j + 1 To myrow - 1 ' compare this col If ActiveCell.Offset(j, i).Value = ActiveCell.Offset(k, i).Value Then If ActiveCell.Offset(j, i).Cells.Interior.Color = 255 Then ActiveCell.Offset(j, i).Cells.Interior.Color = 5287936 ' green Else ActiveCell.Offset(j, i).Cells.Interior.Color = 15773696 ' cyan End If If ActiveCell.Offset(k, i).Cells.Interior.Color = 255 Then ActiveCell.Offset(k, i).Cells.Interior.Color = 5287936 ' green Else ActiveCell.Offset(k, i).Cells.Interior.Color = 15773696 ' cyan End If Exit For End If Next k ' compare this col End If ' if numeric End If ' not if null Next j Next i End Sub ساقية.xls

السلام عليكم ورحمة الله تعالى وبركاته اولا: عملية ربط قاعدة بيانات بمسار محدد توضع حيث يتم وضع قاعدة البيانات التي تحتوي غلي الجداول في نفس مجلد قاعدة الواجهة Autolink Path.rar ---------------------------------------- ثانيا :عملية الربط التلقائي بدون تحديد المسار حيث يتم البحث عن قاعدة البيانات المطلوبة لربط الجداول اينما كانت Autolink Table.rar ---------------------------------------- ثالثا :عملية ربط قاعدة الواجهة باكثر من قاعدة link MultiDB.rar مع اطيب وارق الامنيات بالاستمتاع

فك الفورم وتجميعة فى الصفحات المتعددة الجزء 14 الفيديو الصور

شكرا ابو جودي 🙂

الف شكر استاذنا الغالى جارى التجربة الف شكر استاذ على جزاك الله خير

جزاك الله كل خير استاذنا الكريم

أسأل الله تعالى أن يكرمكم في الدارين إخوتي الكرام.

عمل فورم من خلال الفرام لاستدعاء الصور والتحكم فى مقاساتها الجزء 13 الفيديو الصور

شكراااا @ابوخليل و @kha9009lid

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

جرب التسديد (6).accdb

في السطر الاول الذي وضعة الاستاذ ابو خليل ضع عبارة ts بين علامتي تنصيص ليكون هكذا if me.hhh = "ts" then

لست بحاجة الى اجبار ولا رسايل لما يتم اختيار ts يتم تفريغ حقل money وتتم حمايته اكتب في حدث بعد التحديث لحقل hhh : if me.hhh = ts then me.money="" me.money.Enabled=false else exit sub end if

السلام عليكم أخي الكريم علي محمد علي: جزاكم الله خيراً على تقديم المساعدة لطالبها ...إلا أنه كان من المفترض أن يعمل المرفق في المشاركة الأولى بدلاً من المشاركات الداخلية لتعم الفائدة ...على الرغم من التساؤل (هناك مرفق في المشاركة الأولى ...ولا يعمل ) ...أليس من الأجدى أن يستبدل ؟ أو أن يتم السؤال عن سبب المشكلة ؟ لم لا يعمل؟ والسلام عليكم.

وعليكم السلام 🙂 تقدر تستعمل احد برامج الضغط مثل winzip او winrar وترفقه ، وقبل ذلك ، جرب البرنامج هذا: جعفر

وعليكم السلام 🙂 الشباب هنا عملوا اكثر من طريقة جعفر

احسنت استاذ بن علية كود ممتاز وبعد اذن حضرتك وزيادة فى اثراء الموضوع -هذا كود اخر للحل Option Explicit Sub Inqwayry7() Dim Q1, Q2, q3, FR, TR Dim S_sh As Worksheet: Set S_sh = Sheets("ÇáíæãíÉ") Dim T_sh As Worksheet: Set T_sh = Sheets("ßÔÝ ÇáÍÓÇÈ") Range("A7:j1000").ClearContents Q1 = Range("b2") Q2 = Range("b3") q3 = Range("D2") TR = 7 If Range("b2").Value > Range("b3").Value Then MsgBox "åäÇß ÎØà Ýí ÊÑÊíÈ ÇáÊÇÑíÎ", vbExclamation, "ÎØÃ" Exit Sub End If With S_sh For FR = 7 To 3333 If .Cells(FR, 1) >= Q1 And .Cells(FR, 1) <= Q2 And .Cells(FR, 2) = q3 Then Cells(TR, 1) = .Cells(FR, 1) Cells(TR, 2) = .Cells(FR, 2) Cells(TR, 3) = .Cells(FR, 3) Cells(TR, 4) = .Cells(FR, 4) Cells(TR, 5) = .Cells(FR, 5) Cells(TR, 6) = .Cells(FR, 6) Cells(TR, 7) = .Cells(FR, 7) Cells(TR, 8) = .Cells(FR, 8) Cells(TR, 9) = .Cells(FR, 9) Cells(TR, 10) = .Cells(FR, 10) TR = TR + 1 End If Next FR End With End Sub ولكن بالتأكيد كود حضرتك الأفضل فهو كود صغير وبسيط وادى الغرض بكل كفاءة كشف حساب بين تاريخين.xlsm

تفضل الملف المرفق... ارجو الافادة.xlsm

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

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

خلي يكون صدرك وسيع اخي مسفر

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

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

وراك وراك لين اشوف نهاية الموضوع هذا جرب gg.accdb

لكي يصبح الناتج صحيح تكون المعادلة =ISNUMBER(B2)=ISNUMBER(B3) حتى يتعرف على المكتوب في الخلية أنه رقم حيث أن تنسيق الخليتين ليس رقم

اخي اشرح لي ماتريد وساعمل عليه بعد الصلاة باذن الله

حياك الله تفضل: If Me.l1.Width >= Me.r1.Width Then Me.TimerInterval = 0: DoCmd.OpenForm "YourFormName": Forms![ThisForm].Visible = False l1.Width = l1.Width + 100 T1 = l1.Width / r1.Width

وعليكم السلام تفضل كلهذا الرابط به عدة روابط تخص موضوعك https://www.officena.net/ib/topic/33642-كيفية-ارسال-اميل-عن-طريق-الأكسيل-؟/?tab=comments#comment-175025

الرقم في الخلية B2 مقرب الي ستة ارقام عشرية اما الرقم في الخلية B3 هو بالفعل ستة ارقام عشرية فيصبحا الخليتان متساويتان بالشكل وليس بالمضمون

وعليكم السلام -انظر الى هذه الصورة فبها طلبك

السلام عليكم تم عمل المطلوب في الملف المرفق بتعديل طفيف على كود أخي الكريم Ali Mohamed Ali... بن علية حاجي ترحيل pdf.xlsm

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

السلام عليكم جرب المرفق وفيه حل بسيط (كود بسيط)... بن علية حاجي test.xls

اخي العزيز اذا ما يظهر تحزيم قاعدة بيانات تستطيع ان تتبع هذه الخطوات وهذه مقطع فيديو شرح من قبل عبدالعاطي حمدان

السلام عليكم تفضل اخي عبد العزيز المحترم هذا ما طلبته في الرسالة مؤشر تحميل يمكنك تغيير العبارات والالوان rar.rar

اتفضل اليك نسخة من زيب الشعب يشكرك على ما تقدمه للشعب تم تغيير شيء في الاكواد الان هذه هو الاكواد المستخدمة Option Compare Database Private Sub Form_Open(Cancel As Integer) Me.pr = "سيبدأ التحميل ..." End Sub Private Sub Form_Timer() Static intCount As Integer intCount = intCount + 1 If intCount = 100 Then DoCmd.Close acForm, Me.Name DoCmd.OpenForm "FrmHello", acNormal ElseIf intCount Then Me.pr = "تقدم مؤشر التحقق " & intCount & "%" Me("sq" & intCount).Visible = True End If End Sub استاذنا @sandanet قام بالرد عليك وانا اضفت في الملف الجديد سبحان الله ... كان متصفح مفتوح وما رايت المشاركات الاخيرة مؤشر تحميل.zip

تفضل مؤشر تحميل.zip

نشكرك .. لكن تقدر تستخدم دالة if مرة واحدة بدل 100 مرات هكذا Static intCount As Integer intCount = intCount + 1 If intCount = 1 Then Me.pr = "تقدم مؤشر التحقق 1%" Else If intCount = 2 Then Me.pr = "تقدم مؤشر التحقق 2%" Else If intCount = 3 Then Me.pr = "تقدم مؤشر التحقق 3%" Else If intCount = 4 Then Me.pr = "تقدم مؤشر التحقق 4%" Else If intCount = 5 Then Me.pr = "تقدم مؤشر التحقق 5%" Else If intCount = 6 Then Me.pr = "تقدم مؤشر التحقق 6%" Else If intCount = 7 Then Me.pr = "تقدم مؤشر التحقق 7%" Else If intCount = 8 Then Me.pr = "تقدم مؤشر التحقق 8%" Else If intCount = 9 Then Me.pr = "تقدم مؤشر التحقق 9%" Else If intCount = 10 Then Me.pr = "تقدم مؤشر التحقق 10%" Else If intCount = 11 Then Me.pr = "تقدم مؤشر التحقق 11%" Else If intCount = 12 Then Me.pr = "تقدم مؤشر التحقق 12%" Else If intCount = 13 Then Me.pr = "تقدم مؤشر التحقق 13%" Else If intCount = 14 Then Me.pr = "تقدم مؤشر التحقق 14%" Else If intCount = 15 Then Me.pr = "تقدم مؤشر التحقق 15%" Else If intCount = 16 Then Me.pr = "تقدم مؤشر التحقق 16%" Else If intCount = 17 Then Me.pr = "تقدم مؤشر التحقق 17%" Else If intCount = 18 Then Me.pr = "تقدم مؤشر التحقق 18%" Else If intCount = 19 Then Me.pr = "تقدم مؤشر التحقق 19%" Else If intCount = 20 Then Me.pr = "تقدم مؤشر التحقق 20%" Else If intCount = 21 Then Me.pr = "تقدم مؤشر التحقق 12%" Else If intCount = 22 Then Me.pr = "تقدم مؤشر التحقق 22%" Else If intCount = 23 Then Me.pr = "تقدم مؤشر التحقق 23%" Else If intCount = 24 Then Me.pr = "تقدم مؤشر التحقق 24%" Else If intCount = 25 Then Me.pr = "تقدم مؤشر التحقق 25%" Else If intCount = 26 Then Me.pr = "تقدم مؤشر التحقق 26%" Else If intCount = 27 Then Me.pr = "تقدم مؤشر التحقق 27%" Else If intCount = 28 Then Me.pr = "تقدم مؤشر التحقق 28%" Else If intCount = 29 Then Me.pr = "تقدم مؤشر التحقق 29%" Else If intCount = 30 Then Me.pr = "تقدم مؤشر التحقق 30%" Else If intCount = 31 Then Me.pr = "تقدم مؤشر التحقق 31%" Else If intCount = 32 Then Me.pr = "تقدم مؤشر التحقق 32%" Else If intCount = 33 Then Me.pr = "تقدم مؤشر التحقق 33%" Else If intCount = 34 Then Me.pr = "تقدم مؤشر التحقق 34%" Else If intCount = 35 Then Me.pr = "تقدم مؤشر التحقق 35%" Else If intCount = 36 Then Me.pr = "تقدم مؤشر التحقق 36%" Else If intCount = 37 Then Me.pr = "تقدم مؤشر التحقق 37%" Else If intCount = 38 Then Me.pr = "تقدم مؤشر التحقق 38%" Else If intCount = 39 Then Me.pr = "تقدم مؤشر التحقق 39%" Else If intCount = 40 Then Me.pr = "تقدم مؤشر التحقق 40%" Else If intCount = 41 Then Me.pr = "تقدم مؤشر التحقق 41%" Else If intCount = 42 Then Me.pr = "تقدم مؤشر التحقق 42%" Else If intCount = 43 Then Me.pr = "تقدم مؤشر التحقق 43%" Else If intCount = 44 Then Me.pr = "تقدم مؤشر التحقق 44%" Else If intCount = 45 Then Me.pr = "تقدم مؤشر التحقق 45%" Else If intCount = 46 Then Me.pr = "تقدم مؤشر التحقق 46%" Else If intCount = 47 Then Me.pr = "تقدم مؤشر التحقق 47%" Else If intCount = 48 Then Me.pr = "تقدم مؤشر التحقق 48%" Else If intCount = 49 Then Me.pr = "تقدم مؤشر التحقق 49%" Else If intCount = 50 Then Me.pr = "تقدم مؤشر التحقق 50%" Else If intCount = 51 Then Me.pr = "تقدم مؤشر التحقق 51%" Else If intCount = 52 Then Me.pr = "تقدم مؤشر التحقق 52%" Else If intCount = 53 Then Me.pr = "تقدم مؤشر التحقق 53%" Else If intCount = 54 Then Me.pr = "تقدم مؤشر التحقق 54%" Else If intCount = 55 Then Me.pr = "تقدم مؤشر التحقق 55%" Else If intCount = 56 Then Me.pr = "تقدم مؤشر التحقق 56%" Else If intCount = 57 Then Me.pr = "تقدم مؤشر التحقق 57%" Else If intCount = 58 Then Me.pr = "تقدم مؤشر التحقق 58%" Else If intCount = 59 Then Me.pr = "تقدم مؤشر التحقق 59%" Else If intCount = 60 Then Me.pr = "تقدم مؤشر التحقق 60%" Else If intCount = 61 Then Me.pr = "تقدم مؤشر التحقق 61%" Else If intCount = 62 Then Me.pr = "تقدم مؤشر التحقق 62%" Else If intCount = 63 Then Me.pr = "تقدم مؤشر التحقق 63%" Else If intCount = 64 Then Me.pr = "تقدم مؤشر التحقق 64%" Else If intCount = 65 Then Me.pr = "تقدم مؤشر التحقق 65%" Else If intCount = 66 Then Me.pr = "تقدم مؤشر التحقق 66%" Else If intCount = 67 Then Me.pr = "تقدم مؤشر التحقق 67%" Else If intCount = 68 Then Me.pr = "تقدم مؤشر التحقق 68%" Else If intCount = 69 Then Me.pr = "تقدم مؤشر التحقق 69%" Else If intCount = 70 Then Me.pr = "تقدم مؤشر التحقق 70%" Else If intCount = 71 Then Me.pr = "تقدم مؤشر التحقق 71%" Else If intCount = 72 Then Me.pr = "تقدم مؤشر التحقق 72%" Else If intCount = 73 Then Me.pr = "تقدم مؤشر التحقق 73%" Else If intCount = 74 Then Me.pr = "تقدم مؤشر التحقق 74%" Else If intCount = 75 Then Me.pr = "تقدم مؤشر التحقق 75%" Else If intCount = 76 Then Me.pr = "تقدم مؤشر التحقق 76%" Else If intCount = 77 Then Me.pr = "تقدم مؤشر التحقق 77%" Else If intCount = 78 Then Me.pr = "تقدم مؤشر التحقق 78%" Else If intCount = 79 Then Me.pr = "تقدم مؤشر التحقق 79%" Else If intCount = 80 Then Me.pr = "تقدم مؤشر التحقق 80%" Else If intCount = 81 Then Me.pr = "تقدم مؤشر التحقق 81%" Else If intCount = 82 Then Me.pr = "تقدم مؤشر التحقق 82%" Else If intCount = 83 Then Me.pr = "تقدم مؤشر التحقق 83%" Else If intCount = 84 Then Me.pr = "تقدم مؤشر التحقق 84%" Else If intCount = 85 Then Me.pr = "تقدم مؤشر التحقق 85%" Else If intCount = 86 Then Me.pr = "تقدم مؤشر التحقق 86%" Else If intCount = 87 Then Me.pr = "تقدم مؤشر التحقق 87%" Else If intCount = 88 Then Me.pr = "تقدم مؤشر التحقق 88%" Else If intCount = 89 Then Me.pr = "تقدم مؤشر التحقق 89%" Else If intCount = 90 Then Me.pr = "تقدم مؤشر التحقق 90%" Else If intCount = 91 Then Me.pr = "تقدم مؤشر التحقق 91%" Else If intCount = 92 Then Me.pr = "تقدم مؤشر التحقق 92%" Else If intCount = 93 Then Me.pr = "تقدم مؤشر التحقق 93%" Else If intCount = 94 Then Me.pr = "تقدم مؤشر التحقق 94%" Else If intCount = 95 Then Me.pr = "تقدم مؤشر التحقق 95%" Else If intCount = 96 Then Me.pr = "تقدم مؤشر التحقق 96%" Else If intCount = 97 Then Me.pr = "تقدم مؤشر التحقق 97%" Else If intCount = 98 Then Me.pr = "تقدم مؤشر التحقق 98%" Else If intCount = 99 Then Me.pr = "تقدم مؤشر التحقق 99%" Else If intCount = 100 Then Me.pr = "تم إكتمال التحقق 100%" End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If End If غيره الى هذا Static intCount As Integer intCount = intCount + 1 If intCount Then Me.pr = "تقدم مؤشر التحقق " & intCount & "%" End If

مشكورين إخواني الكرام تم التوصل الى الحل فضل الله ثم بفضل الأخت زهرة جزاها_ الله_ خيرا وكل من ساهم من الإخوان الأفاضل أبو خليل وأبو آدم قد يكون السبب لديك انت في جهازك او انك لم تقم بتنزيل برنامج الفيجول بيسك 6 لأن اداة MSFLXGRD ليست من ضمن ادوات الأكسيس بل هي خاصة ببرنامج الفيجول بيسك 6 عموما حمل المجلد الذي به هذه الأدوات جميعها والخاصة بالـ MSFLXGRD في مجلد النظام C:\Windows\system32 ثم بعد ذلك قم بتسجيل اداة MSFLXGRD.OCX MSFLXGRD.rar