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

السلام عليكم ورحمة الله وبركاته يسعدنى المشاركة معكم فى هذا الموضوع الشيق أولا : فى حالة وجود الفراغات نستخدم هذا الكود 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/ دا الرابط الخاص بالإضافة

السلام عليكم ورحمة الله وبركاته وجدت هذه الدالة اثناء تجولي وحبيت ان اضع عليها مثال هنا لمن قد يبحث عنها الدالة هي FILELEN وهذا ببساطة شكل الدالة FileLen( file_path ) الدالة تحضر حجم الملف بالبايت .. وبإمكاننا التحويل الى ما نريد بعد ذلك هنا طرق التحويل المعروفة للجيمع . 1 Byte = 8 Bit 1 Kilobyte = 1,024 Bytes 1 Megabyte = 1,048,576 Bytes 1 Gigabyte = 1,073,741,824 Bytes 1 Terabyte = 1,099,511,627,776 Bytes في المرفق انا حولت الى كيلوبايت .. اترككم مع المثال .. فك الضغط على الدرايف D للتجربة وبعدها بإمكانك النقل الى اي مكان كل ما عليك هو معرفة المسار والإمتداد بالتوفيق للجميع fileSizeDemo.rar

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

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

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

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

جزيت خيراً أخي الغالي رجب جاويش على الكود الرائع .. أعتقد الثاني أفضل حيث يصلح لكلا الحالتين تقبل تحياتي

هههههههههههههههه ضحكتنا يا ابو البراء وفعلا انا بصيت بصه ملقتوش اخى عبد العزيز هذا رابط التحميل مقسم على 3 اجزاء اختار الميديا فاير ولما تخلص ملف اعمل رستارت للروتر بتاعك علشان تحمل الملف التانى على طول وهكذا لحاد ما تخلص 3 اجزاء بالتوفيق اخى وده رابط تانى هنا بالمنتدى http://www.officena.net/ib/topic/67344-نسخة-فيجوال-بيسك-2010-كامله/?do=findComment&comment=437711 بالتوفيق اخى عبدالعزيز

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

أخي الكريم ناصر شوف الملف التوضيحي ده Watch.rar

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

بارك الله فيك وجزاك كل خير شرح مفصل وواضح جعله الله في ميزان حسانتك

screentogif اتفضل هذا هو رابط موقع البرنامج ورابط تحميل البرنامج https://screentogif.codeplex.com/ https://screentogif.codeplex.com/downloads/get/1554964 واسألك الدعاء للاستاذ الجليل jjafferr فهو من دلنى عليه

حياكم الله استاذ عبد الفتاح يجب ان يكون هناك جدول للدرجات ويكون مرتبط بجدول الموظفين قم بإنشاء استعلام ضع هذا المعيار تحت اسم الدرجة darganame [forms]![frm1]![darganame] وهذا المعيار تحت رقم الموظف empid [forms]![frm1]![empid] عند تشغيل الاستعلام سيطلب منك المعلومتين وهي رقم الموظف والدرجة التي ترغب في الاستفسار عن تاريخها بعدها يعرض البيانات ستظهر لك مكررة بحسب تكرار الدرجة ... وهذا اعتقد بسبب عدم وجود جدول مصدر لهذه الدرجات بالتوفيق تم اضافة المرفق وبإمكانك استخدام النموذج لإدخال البيانات drgat.rar

مثال رقم 3 :- فى المثال رقم 2 كان الشرح على نفس الصوره السابقه فورم فى مرحلة التصميم وصممت عليه Frame والفريم لا يوجد به اى عناصر تحكم تم تصميمها وكان المثال برقم 2 انى اعمل كود عند فتح الفورم يكون هناك عدد 10 صفوف من العناصر كل صف به ليبل وتكست بوكس وكمبوبوكس المثال بتاعنا اليومعايز اعرف ازاى اضيف عناصر تحكم اثناء فتح الفورم من شيت اكسيل وعدد الصفوف بالشيت غير معروف عددها فى زياده او نقصان شاهد الصوره هتعرف اكتر المثال بتاعنا بكل بساطه نفس الكود اللى بالمثال 2 مع تعديلات فنيه بسيطه جدا دا كان الكود اللى بالمثال 2 Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer Top = 5 For i = 1 To 10 With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = "الصقر" & i End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub ايه المطلوب تعديله بالكود لكى يتناسب مع المطلوب بتاعنا رفع الخلايا من الشيت الى الفريم المثال كان على ان عدد الصفوف 10 لذالك استخدمنا الحلقه For next كالتالى For i = 1 To 10 فدلوقتى انا عايز اجيب الخلايا بالشيت رقم 1 النطاق من A2 الى اخر صف هيكون به اخر طالب اذن بداية الحلقه هى اول صف بالجدول وهو الخليه A2 ورقم الصف لها هو 2 اذن الحلقه هتبدأ من رقم 2 الى ؟ الى اخر صف به بيانات فى العمود A اذن لازم احدد اخر صف به بيانات من خلال السطر التالى واحنا شرحناه قبل كدا lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row عملت متغير واسمه Lr وتقدر تسميه اى اسم كيفما شئت وقلت ان المتغير Lr يساوى كتبت اسم الشيت المراد العمل عليه واستخدمت Cells لتحديد عدد الخلايا الممتلئه بالبيانات فى العمود 1 كدا انا عرفت الحلقه من اين تبدأ واين تنتهى ( تبدأ من الصف 2 الى اخر صف به بيانات ) For i = 2 To lr شاهد الكود بعد تعديل الحلقه For Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Top = 5 For i = 2 To lr With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a .Text = Sheet1.Cells(i, 3).Text End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = Sheet1.Cells(i, 1).Text End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub اللى مركز معايا هيلاقى 1- تم تعديل بداية ونهاية الحلقه For 2- فى سطر تم اضافته فى خصائص كل عنصر فى عنصر الكمبوبوكس تم اضافه السطر التالى .Text = Sheet1.Cells(i, 3).Text قيمة الكمبوبوكس هى كتبت اسم الشيت وهو بمثالنا الشيت 1 ثم الخلية المطلوبه Cells عباره عن (رقم العمود, رقم الصف)Cells ( Cells( i , 3 i هنا هى رقم الصف اللى هيتغير كل مره بالحلقه For والعمود هو رقم 3 الخاص بالحاله --------------------------------- فى عنصر التكست بوكستم اضافه السطر التالى .Text = Sheet1.Cells(i, 2).Text نفس الكمبوبوكس ولكن تم تغيير رقم العمود هو 2 الخاص بالدرجه ---------------------------------- فى عنصر الليبل تم اضافه السطر التالى .Caption = Sheet1.Cells(i, 1).Text نفس الكمبوبوكس والتكست بوكس ولكن تم تغيير رقم العمود هو 1 الخاص باسم الطالب ----------------------------------------------------------------------------------------------------------------------- ملحوظه اخيره لمن يريد درجة الاحترافيه فى الكود لما كنا بنعمل خصائص العنصر كان الخاصيه Left & Top & Width& Height لكل عنصر كان بيتم كتابتهم بالشكل التالى كلا منهم على حد فى سطر مختلف على سبيل المثال خصائص التكست بوكس With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With ممكن اكتب الاربع خصائص فى سطر واحد من خلال Move القاعدة الخاصه بــ Move Move Left, Top, Width, Height. ويكون شكل الكود كالتالى بالخصائص With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Move 180, Top, 150, 40 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With تم استبدال الاربع صفوف بسطر واحد من خلال Move -------------------------------------------------------------------------------------------------------- جرب الكود بنفسك هتثبت المعلومه اكتر الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد ان شاء الله هيكون عن كيفية التحكم فى العناصر الموجوده داخل الفريم سوء كانت مصممه اثناء عملية التصميم او تم انشائها بكود انتظرونا تقبلوا تحياتى

أدرك تماما الهدف من الموضوع ولكن الشىء بالشىء يذكر وأكيد فيه كتير من الناس ما تعرفش يعنى ايه Regedit.exe فالحديث عنه هنا قد يفيد شخص ما يوما ما تقبل تحياتى

السلام عليكم طبعا مستفاد من شروح أخرى الفديو المشاهدة التحميل الطريقة 1- اضغط f5 أو مفتاح كنترول + حرف g 2 - من نافذة الانتقال إلى اختر " خاص " 3 - ثم الفراغات 4 - ثم اختر إزاحة الخلايا لأعلى أو غيرها