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

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

السلام عليكم ورحمة الله وبركاته إخوتي وأساتذتي الكرام الحمد لله الذي بنعمته تتم الصالحات بادئ ذي بدء ، ثم الشكر لأخي الحبيب @hassona229....وأقول له الدال على الخير كفاعله جزاكم الله خيراً وأقول لفريق الموقع الكريم بارك الله بجهودكم الأخ @Ali Mohamed Ali وأستاذنا @محمد طاهر عرفه الذي لا يألو جهداً في مساعدته لنا جميعاً ... أخي الكريم @ابراهيم الحداد تهانينا الحارة بعودتك ....وهل يخفى القمر؟! .... نذكر تماماً زيزو العجوز ...الذي ألفناه ....والمؤمن كما يعلم الجميع يألف ويؤلف... مع أجمل تحياتي ....تقبلوا مروري .... والسلام عليكم.

تفضل بالتنسيقات الشرطية 1.xlsx

بسيطة يمكنك استخدام هذه المعادلة فقط =SUMIFS($C$4:$C$17,$F$4:$F$17,"<>"&"مسدد",$B$4:$B$17,"<"&$H$2) 6.xlsx

و عليكم السلام و رحمة الله و بركاته راجع بريدك من فضلك

السلام عليكم و رحمة الله استخدم هذا الكود Sub SumThig() Const str1 As String = "اجمالي العملاء", str2 As String = "اجمالي الموردين" Dim LR As Long, i As Long, x As Integer, y As Integer With Sheets("بيانات") LR = .Range("B" & Rows.Count).End(3).Row For i = 3 To LR If .Range("B" & i) = str1 Then x = i ElseIf .Range("B" & i) = str2 Then y = i End If Next .Range("E" & x) = WorksheetFunction.Sum(.Range("E3:E" & x - 1)) .Range("E" & y) = WorksheetFunction.Sum(.Range("E" & x + 1 & ":E" & y - 1)) End With End Sub

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

السلام عليكم أخي الكريم هذا كود تفقيط جزى الله خيراً من عمله ووضعه بين أيدي الناس ليعملوا به يمكنك تعديله ليناسب عملك Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "يتبقى لكم " Else ReMark = "فقط " End If If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "واحد" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "أربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(Myno, 1, 3)) > 0 Then RdNo = Mid$(Myno, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(Myno, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(Myno, 2, 1) My10 = MyArry2(RdNo) If Mid$(Myno, 2, 2) = 11 Then My11 = "إحدى عشر" If Mid$(Myno, 2, 2) = 12 Then My12 = "إثنى عشر" If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur + " " + "لا غير" Else NoToTxt = ReMark + MyFraction + " " + MySubCur + " " + "لا غير" End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + " " + "لا غير" End If End Function

تفضل

وعليكم السلام وحمه الله وبركاته اتفضا اخى @alaaldin2010 ان شاء الله يكون ما تريد بالتوفيق مثال_1.accdb

أخي محمد عبدالله .. لتطبيق الدوال التي تفضل بها أخي محمد البرناوي .. أكتب هكذا : Dim i As Integer, k As Integer k = Me.NumberTxt ' تخزن القيمة الموجودة في مربع النص في المتغير For i = 1 To k << تضع هنا الأمر المراد تكراره >> Next i 🙂

السلام عليكم أهلا بك أخي ابراهيم ، باذن الله سيتم حل الموضوع هل تتذكر البريد المسجل و كلمة سر الحساب الأصلي ؟ فالحساب الاصلي ليس مسجلا بالبريد اعلاه و انما ببريد مختلف على Yahoo مبدأيا تم فك ربط الحساب مع حساب الفيس بوك ، و بالتالي تستطيع الدخول بصورة طبيعية اذا تذكر البريد و الايميل للحساب الاصلي

وعليكم السلام-تفضل هذه المعادلة =IF(AND(C10>=900,C10<=1000),"متميز",IF(AND(C10>=701,C10<=899),"متفوق",IF(C10=700,"مؤهل",IF(C10="محلول","محلول","")))) وهذه معادلة العمود E =IF(C10="محلول","0%",C10/1000) المصنف2 (1).xlsx

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

بعد ادن استادنا الكبير ابراهيم الحداد واثراءا للموضوع يمكنك استخدام الكود التالي Sub SUM_MH() Dim LastRow As Long, i As Long, officena As Long, MH As Long Application.DisplayAlerts = False officena = 1 With ThisWorkbook.Worksheets("بيانات") LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row + 1 For i = 1 To LastRow If .Range("b" & i).Value = "اجمالي العملاء" Or .Range("b" & i).Value = "اجمالي الموردين" Then MH = i - 1 .Range("C" & i).Value = Application.Sum(.Range(.Cells(officena, 3), .Cells(MH, 3))) .Range("D" & i).Value = Application.Sum(.Range(.Cells(officena, 4), .Cells(MH, 4))) .Range("E" & i).Value = Application.Sum(.Range(.Cells(officena, 5), .Cells(MH, 5))) officena = i + 1 Application.DisplayAlerts = True End If Next i End With End Sub . wor1.xlsm

الشكر لله استاذ احمد من اسهل الطرق لانشاء المجلد عمل ملف يعدل على الرجيستري وهذا مفيد عند تعدد المستخدمين بدلا من ان تقوم بالتعديل اليدوي لكل جهاز [HKEY_CURRENT_USER\Software\Microsoft\Office\16.0\Access\Security\Trusted Locations\Location1] "Path"="\\\\DESKTOP-AOJOU45\\test2\\" "AllowSubfolders"=dword:00000001 "Description"="" هذا المسار خاص بمجلد الشبكة الخاص بي واذا اردت استخدامة ضع مسار الشبكة الخاصة بك السطر الثالث يعني ان المجلدات الفرعية امنه ايضا وفي حالة عدم الرغبة فقط احذف السطر ------------------------------------------------- دائما لا انصح بالتعديل على سجل النظام الا اذا كنت على معرفة بما تعمل قبل اي تعديل انصح بحفظ نسخة احتياطية من سجل النظام جعل مجلد الشبكة امن فيه مخاطرة وحتى شركة مايكروسوفت لا تنصح بذلك تحياتي

الف شكرا على مجهودك ..بارك الله فيك ..لك ودى وتقديرى لشخصك الكريم

عملت فحص للدالة وكانت مخرج الدالة فارغ Empty وليس صفر ، والـ vba يتعامل مع الفارغ كصفر في العمليات الرياضياتية. Debug.Print "*" & Nz(Null) & "*", VarType(Nz(Null)), 2022 + Empty والنتيجة: ** 0 2022

الشكر لله ثم لاخواننا واساتذتنا جزاهم الله عنا كل خير احسنت اخى واستاذى ووالدى العزيز خالد جزاك الله عنا كل خير نعم صحيح وجزاك الله خيرا عالتنبيه الذى لم اعد اقم به

كلام صحيح ولكن اذا استخدمناها في استعلام فلابد من كتابة القيمة البديلة وفي جميع الاحوال الافضل كتابة القيمة البديلة تحياتي

مشاركة مع استاذنا @احمد الفلاحجي طريقة اخرى باستخدام عبارة not in لتكون جملة الاستعلام ⬇️ وهنا لسنا بحاجة الى عمل علاقة بين الجدولين في الاستعلام SELECT [2].[رقم العائلة] FROM 2 WHERE ((([2].[رقم العائلة]) Not In (SELECT [1].رقم FROM 1;))); الملف مرفق استعلام q_2 والعكس لو اردنا ان نحصل على السجلات المشتركة بين الجدول فقط نحذف عبارة not لتكون جملة الاستعلام ⬇️ SELECT [2].[رقم العائلة] FROM 2 WHERE ((([2].[رقم العائلة]) In (SELECT [1].رقم FROM 1;))); ملاحظة استخدام ارقام لاسماء الجداول ليست صحيحة تحياتي مثال_1.accdb

السلام عليكم ورحمة الله تعالى وبركاته اولا اسف على التاخير لم استطيع امس تعديل المعادلات بسبب ضيق الوقت وعدم توضيحك المسبق لامكانية زيادة اوراق العمل تفضل اخي تم وضع المعادلات لغاية 350 صف قابل للزيادة مع التعرف تلقائيا على اوراق العمل المضافة اما في حالة كانت عندك رغبة بالبحث فقط بالقيمة الموجودة في الخانة B4 يمكنك استبدال الكود الموجود في حدث ورقة toutal بهدا الكود رغم اني ارى ان المعادلات افضل بسبب انها تتيح لك رؤية جميع النتائج الموجودة في اوراق العمل كلها في نفس الوقت Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet If Target.Address = "$B$4" Then Me.Cells(4, 3).Resize(, 12).ClearContents If Not IsEmpty(Target) Then Set ws = Worksheets(Target.Value) Select Case ws.Name Case "toutal": Case Else: With Me .Range("C4") = ws.Range("B11") .Range("D4") = ws.Range("B6") .Range("E4") = ws.Range("B8") .Range("F4") = ws.Range("M6") .Range("G4") = ws.Range("B12") .Range("H4") = ws.Range("B13") .Range("I4") = ws.Range("B17") .Range("J4") = ws.Range("K47") .Range("K4") = ws.Range("L47") .Range("L4") = ws.Range("M47") .Range("M4") = ws.Range("N47") .Range("N4") = ws.Range("C81") End With End Select End If End If End If If Target.Count > 1 Or Target.Row <= 2 Then Exit Sub If Target.Column = 2 And Target.Value <> "" And Not (sheetExists(Target.Value)) Then Call newsh(Target.Value) Sheets("toutal").Select End If End Sub mango_MH.xlsm

شكرا جزيلاً استاذي الكريم هذا تماما ما اريده

ايوه مظبوط كله تمام انا راجعت مره اخري القيم مظبوطه اسف يبدو انني كنت اجمع خطأ مش عارف اقولك ايه والله جد اكتر من رائع ربي يجزيك الخير ( بالزاااف ) خلي بالك راح اتعلم مغربي ههههه ناقص بس حاجه واحده تزيدها من فضلك ان احببت بدون ازعاج ولو ماعندك وقت لاينقص من فضلك شيئا بدي افهم فلسفتك في تصميم الملف وهل الدوال دي لا تتلف مع كبر حجم الملف مثلا خاصه انها كبيره فعلا وهل يعتمد عليها خاصه انه ملف شركه وبه ارقام حساسه يصعب تعويضها ان فقدت حبيبي انا ممتن اليك جدا جدا

اخي لم اكتشف اي خطا بالمعادلة قد تم اعادة تجربها مرة اخرى على ما يبدو لي انها صحيحة .وقمت بمقارنتها مع الملف المرفوع من استادنا الكبير محي الدين ابو البشر . تم الحصول على نفس النتيجة .شهر 8 =SOMME.SI.ENS(E10:E100;F10:F100;">="&D5;F10:F100;"<="&FIN.MOIS(D5;0))+SOMME.SI.ENS(G10:G100;H10:H100;">="&D5;H10:H100;"<="&FIN.MOIS(D5;0))+SOMME.SI.ENS(I10:I100;J10:J100;">="&D5;J10:J100;"<="&FIN.MOIS(D5;0))

مثال توضيحي.xlsx

السلام عليكم ورخمة الله اخى الكريم / محمد طاهر اشكرك على اهتمامك بالامر آخر مرة قمت بتغيير الويندوز كان احد عامى 2016 او 2017 ومن يومها و انا استخدم الدخول الى منتدانا المفضل من خلال المفضلة لذلك و بعد تغيير الويندوز حاولت ان ان استخدم عدة كلمات للسر كانت تفشل المحاولة فأجبرت على الدخول على الفيس بوك و لكن وجدت ان الموقع اصبح اسم العضوية فية اكسلنا و يبدو ان هناك عضوا فعلا له نفس الاسم بل هو مشارك من عام 2015 و ان كانت مشاركاته قليلة و لكن اخى الكريم انا اريد ان استرد عضويتى بأسم / ابراهيم الحداد حيث اننى عضو من عام 2013 و قبلها بعدة اعوام كنت اتصفح المنتدى كزائر حتى اصبحت مغرما به و تجاوزت مشاركاتى 1000 مشاركة و يعز على ان ان اصبح عضوا جديدا و يضيع ماسبق هذرا لذا انا مستعد لكافة الاجراءات و الخطوات و الضمانات بأنىى ذلك العضو المدعو / ابراهيم الحداد و ليس احدا يحاول الاستيلاء على هذه العضوية اسف على الاطالة فقد اصبح المنتدى جزءا هاما من حياتى و اصدقك القول انه اصبح صديقى الوحيد بعد خروجى على المعاش من حوالى 4 سنوات و للعلم مازالت عضويتى فى منتدى اكاديمية الصقر بنفس الاسم و لم تحدث الى معوقات فى الدخول بعد تغيير الويندوز و لكم وافر الشكر و التحية افضل مراسلتى على بريدى الياهو و هو : ibrahim200058@yahoo.com و ان كنت لا امانع من مراسلتى على الجيميل و هو : mribrahim1958@gmail.com اخيك / ابراهيم الحداد

شكرا اخي الفاضل ..وجدت الحل ..و هو كتابة المعادلة مرتين بينهما علامة + و تغيير كلمة منقطع في معادلةالثانية الى باقي وجدت الحل ..و هو كتابة المعادلة مرتين بينهما علامة + و تغيير كلمة منقطع في معادلةالثانية الى باقي ..تحياتي للجميع =COUNTIFS(sgel1!$G:$G;$M$6;sgel1!$Q:$Q;"ذكر";sgel1!$E:$E;"باقي*")+COUNTIFS(sgel1!$G:$G;$M$6;sgel1!$Q:$Q;"ذكر";sgel1!$E:$E;"منقطع*")

دوال التكرار كثيرة ... انظر وطبق الأول: الدالة For Dim i As Integer, k As Integer k = 4 For i = k To 1 Step -1 MsgBox i Next i الثاني: الدالة Do While Dim i As Integer i = 4 Do While i >= 1 MsgBox i i = i - 1 Loop الثالث: الدالة Do Until Dim i As Integer i = 4 Do Until i < 1 MsgBox i i = i - 1 Loop الرابع: الدالة Do.....Loop Until Dim i As Integer i = 4 Do MsgBox i i = i - 1 Loop Until i < 1 الخامس: الدالة Do.....Loop While Dim i As Integer i = 4 Do MsgBox i i = i - 1 Loop While i >= 1

وعليكم السلام 🙂 وقد قمت بشرح اوسع للدالة هنا : . جعفر

صدقا روعة @rockjone33 .... لدي استفسار اذا سمحت حول ظهور داخل قائمة الجداول table : جدول يبدأ ب f_ggdhkhtukh1347.data في كل قاعدة بيانات يظهر جدول لم يتم انشائه يدويا ... ممكن توضيح ... وحصل معي هذة المشكلة

تفضل اخي مثال توضيحي.xlsx

جرب اكتب مسار الشبكة انا جربت الان وتعمل بدون مشاكل لمعرفة مسار مجلد المشاركة انقر بزر الفارة الايمن على المجلد المشترك ثم خصائص ثم تبويب مشاركة تجد المسار مكتوب انظر للصور المرفقة

نعم توجد ولكني اعتذر عن شرحها وسوف اشرح طريقة انشاء مجلد امن الشرح لاصدارات من 2016 الى 2021 نقوم بانشاء مجلد على درايف c او d انا عملته على c وسميته kha ونسخت له ملف قاعدة البيانات في قائمة ملف في اكسس اختار خيارات ثم مركز التوثيق ثم اعدادات مركز التوثيق ثم المواقع الموثوق بها ثم اضافة موقع جديد واختار المجلد انظر الصور تحياتي هذا الخيار موجود في نفس الطريقة التي شرحتها ☝️ولكنه غير مستحسن

السلام عليكم أخي الكريم @ayman ahmed أرأيت إن أرفقت ملفاً تعرض من خلاله المشكلة التي واجهتك بما يخص التعامل مع هذه الدالة، سيكون المجال أرحب وأفضل من هذه الأسطر التي شرحت لأن من سيجيبك سيعمل على التخمين فإما أن تصيب أو تخيب.... من هذه التخمينات مثلاً: هل تم تحديد البيانات المراد البحث من خلالها باستخدام مفتاح F4 ؟. =VLOOKUP(A2;$B$2:$C$5;2;0) ماهو تنسيق الخلايا الذي ستدرج الإجابة فيها (نص - عام - رقم ...إلخ...). الملف الأصلي غير مطلوب إحضاره ،أو إرفاقه بل المطلوب ملف مماثل ببيانات وهمية تحقق لمن يريد المساعدة إمكانية التعامل بشكل أمثل مع طلبك ليتسنى لك تطبيق الحل على ملفك الأصلي بكل سهولة ، بمعنى كم عدد الأعمدة لهذه الورقة أو تلك، مع تنسيق يشبه تنسيق الملف لديك.. هذا والله أعلم. والسلام عليكم

اخى واستاذنا الفاضل @Ali Mohamed Ali للرفع رفع الله قدركم

السلام عليكم ورحمة الله وبركاته الدخول يكون عن طريق الاميل استاذنا الفاضل @ابراهيم الحداد مفروض كده تم ارسال رساله لك على الميل سواء كان Gmail Yahoo Hotmail

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

السلام عليكم ورحمة الله ضع هذه العبارة On Error Resume Next قبل هذا السطر Sheets(ShNam).Range("C5").Resize(p, UBound(Temp, 2)).Value = Temp

الحل الاول Application.FollowHyperlink CurrentProject.Path & "\" & List1.Column(1) & ".pdf" الحل الثانى Dim OpnPdf As Variant OpnPdf = Shell("explorer.exe " & CurrentProject.Path & "\" & List1.Column(1) & ".pdf", vbNormalFocus) ------------------------ لتلافى الخطأ فى حالة عدم وجود ملف الـ PDF اضافة الروتين الاتى Function IsFile(ByVal fName As String) As Boolean On Error Resume Next IsFile = ((GetAttr(fName) And 16) <> 16) End Function وفى حدث عند النقر على الـ ListBox ضع الكود الاتى Dim pdfPath As String pdfPath = CurrentProject.Path & "\" & List1.Column(1) & ".pdf" If IsFile(pdfPath) Then Dim OpnPdf As Variant OpnPdf = Shell("explorer.exe " & pdfPath, vbNormalFocus) Else MsgBox "File Not found " End If وهذا ملفك بعد التعديل pdf.zip