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

السلام عليكم ورحمة الله وبركاته يسعدنى المشاركة معكم فى هذا الموضوع الشيق أولا : فى حالة وجود الفراغات نستخدم هذا الكود Sub Transpose_RG() Dim i As Integer Dim LR As Integer Dim arr() As Variant '============================================================= [B1:B1000].ClearContents LR = Cells(Rows.Count, 1).End(xlUp).Row ReDim arr(1 To LR) '============================================================= For i = LR To 1 Step -1 arr(LR + 1 - i) = Cells(i, 1) Next [B1].Resize(LR) = Application.WorksheetFunction.Transpose(arr) End Sub وفى حالة اهمال الفراغات نستخدم الكود التالى Sub Transpose_RG() Dim i As Integer Dim ii As Integer Dim LR As Integer Dim arr() As Variant '============================================================= [B1:B1000].ClearContents LR = Cells(Rows.Count, 1).End(xlUp).Row '============================================================= For i = LR To 1 Step -1 If Not IsEmpty(Cells(i, 1)) Then ii = ii + 1 ReDim Preserve arr(1 To ii) arr(ii) = Cells(i, 1) End If Next [B1].Resize(ii) = Application.WorksheetFunction.Transpose(arr) End Sub Transpose.rar Transpose2.rar

أخي الكريم الغالي ياسر العربي كثر المنادون عليك فهلا أجبت لهم النداء .. !

ال السّلام عليكم ورحمة الله وبركاته أخي الحبيب عبد العزيز: إخوتي الكرام إذاً نحن متفقون على استكمال ما بدأ به أخونا الحبيب أبو أسيل نرجع كلنا على المصطبة ونستضيف معنا الأخ أحمد الفلاحجي والبط راح يكون أطيب الموائد عند صاحب الكرم والجود ... مرحباً بكم بالمصطبة العامرة بالأحباب ..والسلام عليكم.

هنا اختصار للكود Sub معاينة_مع_الطباعة() ActiveWindow.SelectedSheets.PrintPreview If MsgBox("هل تود الطباعة بعد المعاينة؟", vbYesNo + vbQuestion, "طباعة") = vbYes Then ActiveSheet.PrintOut End Sub

بارك الله قيك اخي الفاضل رجب و اسمح لي باضاقة بسيطة على الكود ليتجنب التكرار و يصبح هكذا Sub Transpose_RG1() Dim i As Integer Dim ii As Integer Dim LR As Integer Dim arr() As Variant '============================================================= [B1:B1000].ClearContents LR = Cells(Rows.Count, 1).End(xlUp).Row '============================================================= For i = LR To 1 Step -1 x = Application.WorksheetFunction.CountIf(Range("a1:a" & i), Cells(i, 1)) If x > 1 Or Cells(i, 1) = Empty Then GoTo 1 ii = ii + 1 ReDim Preserve arr(1 To ii) arr(ii) = Cells(i, 1) 1: Next [B1].Resize(ii) = Application.WorksheetFunction.Transpose(arr) End Sub

أضحكتني ...أضحك الله سنك .. عليك بتلاوة الزهراوين والإخلاص والمعوذتين ....لتطرد عنك هؤلاء العفاريت.

إذا كان على شغل العفاريت فأنا بقالي نص ساعة بدور على موضوع الأسبوع اللي فات "استخراج الصور" ومش لاقيه .. يبدو أنه حذف عن طريق الخطأ .. المشكلة مش في كدا ..دخلت على الموضوعات المحذوفة مش لاقيه .. يبدو إنه فيه فعلاً قطط تتح بتلعب في المنتدى !! ربنا يستر وميجبوش ضلفها

السّلام عليكم و رحمة الله و بركاته أخي الحبيب " أحمد الفلاحجي " .. سأروي لك حكاية ليلة من إحدى ليالي 1000 ليلة و ليلة : أشتغل على WINDOWS 8 BUILD 9200 32 بايت .. أردت عمل باكاجْ لأحد المشاريع التجريبية .. على نسخة الفيجوال بيسك البروفيسيونال أعمل الحفظ EXE .. ثم بمجرّد الانتقال إلى الباكاج .. تعلق الماوسْ و تبدأ تدور إلى ما لا نهاية من الوقت .. إستفسرت عن سبب ذلك .. و لكل رأيه .. http://vb4arb.com/vb/thread-15121.html حذفت الوينداوز 8 .. و قمت بتسطيب الاكس بي .. بمنتصف التسطيب .. علقت .. و لم تكتمل .. ال CD .. لست أعرف ما به فكرت بالويندوز 7 .. قمت بتسطيبها .. و يا ريت ما قمت بذلك المشروع إتلخبط .. و عند فتحة كل المكتبات لم يتعرف عليها .. أحسست أن هذ الويندوز 7 سيدخلني بدوامة قلت بنفسي .. الرجوع إلى الأصل فضيلة .. الويندوز 8 أشتغل عليها منذ حوالي سنتين .. سأرجع إليها .. و كرهت المشروع المفاجأة أني لما أعدت تسطيب الويندوز 8 .. رجع الباكاجْ يعمل بطريقة ممتازة و سليمة ألف بالمئة هذا الفيجوال بيسك .. أرهقني كثيرًا فائق إحتراماتي السّلام عليكم و رحمة الله و بركاته أخي الحبيب الغالي " ياسر العربي " إشتقت لك و لكل حبايبي ..أولئك الذين أحببتهم في الله إشتقت للأيام الحلوة .. و لإبداعك المستمر نحن بالانتظار رجاء .. متطولش علينا كثيرًا إحتراماتي

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

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

حياك الله .. تفضل mosadd: nz(DSum("[amount]";"payment";"[student_ser]=" & [student_ser] & " and [year_code]=2");0) بالتوفيق

و عليكم السلام و رحمة الله وبركاته اخي الفاضل جرب المرفق في العمود الأول ادخل اسم المشروع تظهر لك بياناته ان كانت موجودة لإستخراج بيانات محددة من نفس الورقة في اعلى الورقة في الخانة الصفراء F1 اكتب اسم المشروع تظهر لك كل بيانات هذا المشروع فقط امسح البيانات من F1 تظهر لك كل البيانات الكود المستخدم Private Sub Worksheet_Change(ByVal Target As Range) Dim TR, TC, ER, FR, CC TR = Target.Row TC = Target.Column If TR > 3 And TC = 1 Then ER = Sheets("sheet2").UsedRange.Rows.Count For FR = 1 To ER If Sheets("sheet2").Cells(FR, 1) = Sheets("sheet1").Cells(TR, 1) Then For CC = 2 To 5 Sheets("sheet1").Cells(TR, CC) = Sheets("sheet2").Cells(FR, CC) Next CC End If Next FR End If If TR = 1 And TC = 6 Then Dim RN As Range ER = ActiveSheet.UsedRange.Rows.Count Set RN = Range("A3:I" & ER) CC = Cells(TR, TC).Value If CC = "" Then RN.AutoFilter Else RN.AutoFilter Field:=1, Criteria1:=CC End If Cells(TR, TC).Select End If End Sub مع التحية expenses--az.rar

التقويم السنوى يمكن من خلال المرفق طباعة التقويم السنوى وتقريبا انا عملته حتى عام 2044 يا مين يعيش التقويم السنوي.rar

بسم الله الرحمن الرحيم اخوانى اصدقائى اعضاء المنتدى الكرام السلام عليكم ورحمة الله وبركاتة اقدم لكم اليوم درس جديد فى vba ودة كان ردا على سؤال احد الاخوة https://youtu.be/jLLXfCYzCvE فتح الشيتات من خلال الكومبو بوكس.rar

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله الموضوع ليس موضوع علمي إنما هو تسويق لشغل للمدارس الثانوية .. عايز نلم الجرشينات ونحاول نعوض الوقت اللي بقضيه في تعلم البرمجة خدمة عمل كشوف 150 د ثانوية عامة ، حيث يتم تصدير البيانات من على الموقع إلى ملف إكسيل جاهز للطباعة وقابل للتعديل .. الخدمة مقابل 10 جنيهات فقط (يعني يدوب حق كارت شحن ... يا بلاااااااااااااااااااااااش ) مرفق صورة للشكل المخرجات التي سيتم تسليمها لمن أراد الخدمة التسليم يتم في خلال نصف ساعة فقط .. عن طريق الإيميل أو الفيس بوك أو أي وسيلة أخرى مناسبة للعميل للاتصال : Facebook : yakh777@yahoo.com Mobile : 01281054545 وتقبلوا وافر تقديري واحترامي والسلام عليكم ورحمة الله وبركاته

اشكرك استاذي الكريم سعيد .. كلها تعمل بشكل سليم الا مجموع الاستعلامات CurrentDb.QueryDefs.Count بحيث ان عندي في قاعدة البيانات استعلام واحد .. لكن يظهر في المجموع 267 ؟!! اضحك الله سنك لي غرض احصائي في برنامجي فاحتاج لمعرفة الاعداد بدون استخدام العد على الاصابع وحيث اني بحثت عن هذه المعلومة التي خطرت على بالي في المنتدى ولم أجد شخص قد تطرق لها وجدت الحل CurrentData.AllQueries.Count

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

رائع كعادتك اخى سليم جزاك الله خيرا تقبل تحياتى

انسخ هذه المغادلة الى الخلية E6 واسحب نزولاً =IFERROR(IF(A6="","",SUM(B6*D6)),D6)

هههههههه وممكن انم تعدهم وتحسبهم لكن لى سؤال ما الفائدة من هذا المطلب الغريب

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

هههههههههههههههه انا اسف اخى عبده الزهايمر هيشتغل باين كده اتفضل ياغالى http://www.dev-point.com/vb/t385482.html تقبل تحياتى

تمام يا ابوالبراء جزاك الله كل خير

السلام عليكم ورحمة الله وبركاته نبتعد قليلاً عن أسلحة الدمار الشامل .. وننتقل إلى ملف ذو فائدة كبيرة إن شاء الله معكم اليوم : دانلود مانجر داخل الإكسيل ..حمل ملفاتك وعيش حياتك وانسى التفعيل والكراكات .. طبعاً لا بديل عن الداونلود مانجر في تحميل الملفات ، ولكن ملف اليوم ممكن يكون بديل مؤقت ، عشان لو حصلت مشكلة في التحميل متعطلش !! أترككم مع رابط الفيديو لكيفية استخدام البرنامج .. تقبلوا تحيات أخوكم أبو البراء ودائماً إن شاء الله مع كل جديد ومفيد دمتم على طاعة الله Download Internet Files Automatically.rar

السّلام عليكم و رحمة الله و بركاته الأخَوان الفاضلان "محمد حسن المحمد" "أحمد الفلاحجي" فعلا كانت أيام جميلة .. ياريت ترجع .. الأخ الغالي " ياسر العربي " .. ربما لظروف قاهرة منعته من إتمام المسيرة معنا البركة فيكما بإمكانكما إرجاعنا للزّمن الجميل بالنسبة لسؤال الأخ الكريم " أحمد الفلاحجي " ..قمت بتحميل النسخة البورتابل مند أسبوع .. صغيرة الحجم .. كنت أحسب أنّي " جبت الأسد من أذنه .. لكن يا فرحة ما تمّت ..فهي لا تصلح لشيء إحتراماتي

شرفتم الموضوع إخواني وأحبابي في الله .. والحمد لله أن نال إعجابكم وأرجو أن تستفيدوا منه

السلام عليكم عمل ناجح ومتميز ...تمت التجربة بنجاح100% جزاكم الله خيراً..أخي المعطاء أبو البراء والسلام عليكم.

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

أستاذ سعيد صواب أشكرك فقد عملت الدالة وجزاكم الله خيرا .

السلام عليكم بهد اذن اخي و صديقي احمد اليك هذا الملف الذي يغمل بالمعادلات مع الاشارة الى ان القوائم المنسدلة مطاطة(تستجيب لاي تغيير في البيانات ولا تذكر المكرر الا مرة واحدة) expenses salim.rar

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

شوف الفيديو ده لعله يفيدك تقبل تحياتي

أعتقد بالنسبة للفيديوهات أمرها صعب شوية خصوصاً اليوتيوب .. فيه إضافة للفايرفوكس جميلة جدا اسمها Video Download Helper بتجيب لك الروابط الخاصة بالفيديو بكل الأحجام .. https://addons.mozilla.org/en-US/firefox/addon/video-downloadhelper/ دا الرابط الخاص بالإضافة

صدّقني أخي الفاضل و أستاذي القدير " ياسر خليل أبو البراء " لو كان ينفع معي هذا البرنامج .. كنت أوّل من دفع هذا المبلغ الرّمزي لأنّ أعمالك عبارة عن دُرَر نفيسة .. و القصد شراء العلم من منابعه و أنت تبارك الله .. أهْلٌ لذلك إحتراماتي

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

سلم يارب سلم اللهم انا نعلم اننا قد عصيناك اللهم انا نعلم كم عصيناك... و اننا نستحق عقابك... لكن اللهم يامن لا يرد سائله ولا يـُخيِّب للعبد رجاءه إنا قد بسطنا إليك أكف الضراعة متوسلين إليك بأسمائك الحسنى ما علمنا منها وما لم نعلم اللهم ردنا إليك رداً جميلاً . اللهم ردنا إليك وأنت راضٍ عنا اللهم يا غفار الذنوب ، يا ستار العيوب ، يا قابل التوب ، يا واسع المغفرة ، يا من كتب على نفسه الرحمة ، يا رفيع الدرجات ، يا سامع الأصوات يا مجيب الدعوات ، يامن لا على أمره أمر يا فعال لما يريد ، يا هادي الذين آمنوا إلى صراط مستقيم ، يا ذا الرحمة الواسعة ، يا ذا الفضل والنعم ، يا ذا القوة المنين يا ذي الفضل على المؤمنين ،يا ذا العفو والمغفرة ، يامن لا يضيع أجر المحسنين ، يامن عنده مفاتيح الغيب يامن لايعزب عنه مثقال ذرة في الأرض ولا في السماء ، يامن يعلم السر وأخفى ويعلم ماتكتمون يامن له مقاليد السموات والأرض وهو السميع العليم ، يامن له الأسماء الحسنى ، يامن له الحمد في الأولى والآخرة وإليه ترجعون ، يا شاهداً غير غائب يا قريب غير بعيد أسألك أن تصلي على سيدنا محمد وعلى آله وصحبه وسلم اللهم بسر هذه الدعوات المستجابات أن تقضي لنا جميع الحاجات وأن تطهرنا من جميع السيئات وأن تنجينا من جميع الأهوال والآفات ، وأن ترفعنا عندك أعلى الدرجات ، وأن تبلغنا أقصى الغايات من جميع الخيرات في الحياة وبعد الممات ونسألك أن تُفَرِّجَ عنا ما نحن فيه وأن تُقَدِّرَ لنا الخير فيما نريده ونوينا عليه وأن تعصمنا من الفتن والمعاصي والفحشاء وأن تحفظنا وأهلنا وذريتنا وأحبابنا فيك ولمن وصانا ووصيناه بالدعاء من كل سوء وشر وبلاء وأن تنصرنا على جميع الأعداء . وأن تجعلنا من الذين لا خوف عليهم ولاهم يحزنون.

الأخت الفاضلة رشا إليك كود يقوم بإنشاء ورقة عمل جديدة ويضع فيها كل الروابط الخارجية المرتبطة بالمصنف Sub ListExternalLinks() Dim WB As Workbook Dim Link, xIndex As Long Set WB = Application.ActiveWorkbook If Not IsEmpty(WB.LinkSources(xlExcelLinks)) Then WB.Sheets.Add xIndex = 1 For Each Link In WB.LinkSources(xlExcelLinks) Application.ActiveSheet.Cells(xIndex, 1).Value = Link xIndex = xIndex + 1 Next Link End If Columns(1).AutoFit End Sub وإليكي كود يقوم بكسر كل الروابط الخارجية الموجودة داخل المصنف ولكن راعي انه سيتم تحويل القيم المرتبطة بهذه المصنفات إلى قيم اي أن الارتباط سيفقد مع المصنف الآخر Sub BreakExternalLinks() Dim ExternalLinks As Variant Dim WB As Workbook Dim X As Long Set WB = ActiveWorkbook ExternalLinks = WB.LinkSources(Type:=xlLinkTypeExcelLinks) For X = 1 To UBound(ExternalLinks) WB.BreakLink Name:=ExternalLinks(X), Type:=xlLinkTypeExcelLinks Next X End Sub تقبلي تحياتي

ليك وحشة والله أخي الحبيب علاء رسلان يا ريت لو فيه حد من الأخوة يعرف يتواصل معاه يطمنا عليه ويبلغه سلامي الحار ..

أخي الكريم رضا وعليكم السلام ورحمة الله وبركاته جرب الخطوات التالية في الصور ----------------------------------

السّلام عليكم و رحمة الله و بركاته أخي الغالي " أحمد الفلاحجي " .. بارك الله فيك على الأداة المرفقة .. نعم قمت بتفعيل النسخة بنفس الأداة .. لست أدري قد أكون أنا لم أفهم كيفية العمل بها .. المشكلة أخي الكريم أنّي لم أتمكن من عمل PACKAGE بهذه النسخة .. فائق إحتراماتي

الحمد لله بالتوفيق اخوي عبدالله

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

أخي الكريم أحمد أليس هذا هو الكود الذي أرفقته ؟؟ Sub رصد_سرى() Columns("D:F").Select Selection.EntireColumn.Hidden = False With ActiveWorkbook.Worksheets("ادخال درجات دور ثان").Sort End With Columns("B:D").Select Selection.EntireColumn.Hidden = True Range("F9").Select End Sub أين الترتيب في الكود ..مجرد كلمة Sort .. من غير أي تحديد للعمود الذي سيتم الفرز والترتيب على أساسه ؟ أعتذر لعدم متابعتي الموضوع من البداية .. وبالفعل أنا من الأمس وأنا متعب ومرهق للغاية ..ونمت بالأمس باكر حتى أستطيع أن أستعيد نشاطي .. أرجو توضيح المطلوب بدقة مرة أخرى .. هل المطلوب الترتيب على أساس عمود السري وفقط ؟ أم إخفاء لأعمدة محددة وما هي الأعمدة؟ ويا ريت نركز على مطلوب واحد فقط حتى لا أتشتت

السلام عليكم إخوتي الكرام ...جزاكم الله خيراً على ما تقدمونه وأقول لكل منكم

تم حل المشكلة جزاك الله خيرا

أنا أوّل المجيبين بهذه المعادلة (البيانات في العامو د A) وتوضع المعادلة في اي مكان تريد =INDEX($A$1:$A$6,ROWS(A1:$A$6)) و اذا اردتها افقية اكتب هذه(برده اينما تريد) =INDEX($A$1:$A$6,COLUMNS(A1:$F$6))

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

الاخ ابو خليل المحترم ارجو توضيح الاجراء الواجب وضعه بين السطرين اعلاه .. علما اني وضعت command لتنفيذ استعلام تكوين جدول تنفيذ الاستعلام يتم يدويًا أم عن طريق زر ؟؟؟؟ لو عن طريق زر فالكود السابق يوضع فى شاشة VBA وليس فى جملة الSQL الخاصة بالاستعلام ، يعنى تقف على الزر الذى تضغط عليه لتنفيذ الاستعلام وتختار من شاشة الخصائص حدث ومنه عند النقر ستفتح شاشة الكود الخاص بالزر وتضع الكود السابق بين الصطرين Private sub والEnd sub الاخ N-ELMASRY اشكرك على الاجابة الرائعة ... نفذتها لدي واشغلت بشكل صحيح كون المثال الذي ارفقته قد استفدت منه في التوضيح بشكل كبير ... وفقك الله واشكرايضا المبدع الاخ ابوخليل المحترم والسيد حسين عربي على تفاعلهم واجاباتهم مع الموضوع ..

تفضل المرفق به مثال واحد للتوضيح وهكذا مع بقية الأكواد نسخ لصق للكود ComboBox-Exemple.rar

مع ملاحظة أن السطرين myrows = 20 mycols = 5 لتحديد مجال البحث ، و اذا اردت البحث بدءا من الخلية الفعالية الي آخر الشيت فأزل السطران Sub FindFirstEmpty() ' ' Application.ScreenUpdating = False Cells.Select myrows = Selection.Rows.Count mycols = Selection.Columns.Count myrows = 20 mycols = 5 origraw = myrows ActiveCell.Select For i = 0 To myrows - 1 For j = 0 To mycols - 1 If ActiveCell.Offset(i, j).FormulaR1C1 <> "" Then GoTo newrow End If Next MsgBox "Founf the Fist Empty Row " ActiveCell.Offset(i, j).Activate ActiveCell.EntireRow.Select Exit Sub ' ActiveCell.Offset(1, 0).Activate ' myrows = myrows - 1 newrow: Application.StatusBar = " checking ...." & _ Format(i / origraw, "0.0%") & " Please Wait......." Next i Application.ScreenUpdating = True Application.StatusBar = False End Sub FindFirstEmpty.zip