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

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

وعليكم السلام ورحمة الله وبركاته أخي الحبيب محمد غازي بارك الله فيك وجزاك الله كل خير .. وجعل أعمالك في ميزان حسناتك يوم القيامة تقبل وافر تقديري واحترامي

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

جرب الكود بهذا الشكل أخي الكريم طائع ويرجى التركيز على طلب واحد فقط في كل مرة لكي لا أتشتت .. لا أحب كثرة الطلبات في آنٍ واحد تناول نقطة نقطة حتى إذا انتهيت من نقطة انتقلت لأخرى وهكذا Sub Rasd_Secret() Dim LR As Long Columns("D:F").EntireColumn.Hidden = False With Range("C1", Range("C" & Rows.Count).End(xlUp)) LR = Evaluate("MAX(IF((" & .Address & "<>"""")*(" & .Address & "<>0),ROW(" & .Address & ")))") End With If LR < 9 Then LR = 9 Else LR = LR Range("B9:R" & LR).Sort Key1:=Range("F9:F" & LR), Order1:=xlAscending, Header:=xlNo Columns("B:D").EntireColumn.Hidden = True End Sub

شاكر لحضرتك على كلماتك فعلا عندك حق فى كل ما قلته

هنا اضافة بالنسبة للجداول السطر الأول سيظهر لك عدد الجداول مع جداول النظام استخدم هذا الكود ليظهر لك عدد الجداول بدون جداول النظام aa مربع نص في النموذج مثلا لنظهر النتيجة به Dim tdf As TableDef Dim i As Integer For Each tdf In CurrentDb.TableDefs If Left(tdf.Name, 4) <> "MSys" Then i = i + 1 Next Me.aa = i بالتوفيق

ماشاء الله كود جميل تم به المطلوب اكرر شكري لك استاذ ياسر

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

ذكرتني بمثال عندي يحسب حجم البيانات داخل قاعدة البيانات حجم البيانات في البرنامج.rar

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

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

لعد م مسح البيانات احذف هذا الجزء من الكود Sheet1.Range("A3:C3") = "" لتوسيع النطاق غير عمود C الي اى عمود تريدة لزيادة عرض النطاق ولطول النطاق هنا 50000 ممكن تزوده برده azsh = Sheet2.Range("c50000").End(xlUp).Row + 1 يمكن عمل الكود بالطريقتين بموديل او بدون موديل لو بدون موديل ممكن تحط الكود داخل الزر من المطور ,, ادراج ,, زر نوعه activeXcontrol دبل كليك على الزر وانت فى وضع المصمم مرفق الملف يعمل بدون موديل tr7eel.rar

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

Dim Stest As Byte Stest = Mid([Text2], 1, 2) هو متغير وهو يمثل الرقمين الاولين من كل باسوورد مدخل فعند ما يدخل المستخدم كلمة المرور وضعنا شرط وهو النظر الى stest فاذا كان 22 نفتح نموذج كذا واذا كلن 33 نفتح نموذج والا نفتح النموذج الثالث

طيب جرب وضع المعيار بهذه الطريقة >"0" لم انتبه للصورة جيدا هذا الحقل هو طريح السنة من الحقل aaa اذا لابد من وجود قيمة مسبقه فى الحقلين قبل تطبيق المعيار اكبر من صفر فضلا وليس امرا توضح ماذا تريد من هذا المعيار وترفق قاعدة البيانات حتى تكتمل الرؤية ويسهل تقديم المياعدة ان شاء الله

تم معالجة الامر القاعدة if.rar حل اخر بواسطة الماكرو القاعدة if salim Macro.rar

بسم الله الرحمن الرحيم اليوم سنقوم بشرح طريقة ربط الفيجوال بيسك بالإكسيل اولا نعمل مشروع جديد عبارة عن فورم وواحد كمبوبوكس وسته تكست وثمانية ليبل وخمس أزرار وملف اكسيل بامتدادxlsx واسمه aseel امتداده اظن لا يدعم وحدات الماكرو بس عادي مع الفيجوال شغال بنفس ترتيب الشكل الاتي: خلصنا الشكل السابق ندخل علي الشغل الجديد بقي كلنا أكيد سمعنا عن المتغيرات وكلنا تعاملنا معاها قبل ما نشوف المتغيرات الفيجوال عشان نربطه بالإكسيل لازم له مراجع ومتغيرات عامة على مستوى المشروع بأكمله إيه الكلام دا بيتعمل ازاي المرجع دا ولا بنجيبه منين شوفو معايا الصور بعد الخطوات دي ياترى بنعرف نضيف موديول زي ما بنضيف فورم جديد كدا اللي بيعرف يضيف اللي مش عارف ينزل للصورة معايا ويشوف ايه البيانات دي يامعلمين دي بقي المتغيرات العامة اللي بنقول عليها وبتكون علي مستوى المشروع بأكمله يعني لازم تتحط في موديول ولتبسيط الكلام اللي فوق دا بطريقة سهلة اول سطر Public YXL As New Excel.Application YXL دا متغير يشير الى برنامج الاكسيل نفسه بمعنى عندما نريد ان نكتب في الاكسيل Application. Visible = False نكتبه كدا YXL. Visible = False اكيد وصلت الفكرة ولو مش وصلت نكمل مثال كمان المتغير ونظيره في الإكسيل YWB= Workbook YSheet= Worksheet YRng= Range اكيد الامور اصبحت سهلة كدا أي كود في الإكسيل نستبدل المذكورين في أعلاه بنظره في الإكسيل وسيعمل الكود بإذن الله يعني مش هتخترع اكواد جديدة هي نفس القديمة بس تعديلات طفيفه المهم الكل يكون عمل الفورم والموديول والاداوت كما ذكرت سابقا بالترتيب الموجود عشان الاكواد متتبدلش مع الادوات نيجي بقي للاكواد Private Sub Combo1_Click() 'جدا الكمبوبوكس ومنه بيتم جلب البيانات بمعلومية الرقم والكود طبعا مفيهوش جديد نفس اكواد الاكسل With YSheet LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row For iRow = 6 To LastRow If .Cells(iRow, 2) = Combo1.Text Then Text1.Text = .Cells(iRow, 2) Text2.Text = .Cells(iRow, 3) Text3.Text = .Cells(iRow, 4) Text4.Text = .Cells(iRow, 5) Text5.Text = .Cells(iRow, 6) Text6.Text = .Cells(iRow, 7) End If Next End With End Sub Private Sub Command1_Click() Dim lstrow As Long 'ودا كود ترحيل البيانات ونفس الشئ مش جديد كل اللي اتغير اللي ذكرنااه If Text1.Text = "" Then MsgBox "íÌÈ ÇÏÎÇá ÌãíÚ ÇáÈíÇäÇÊ" Else lstrow = YSheet.Range("b20000").End(xlUp).Row + 1 YSheet.Cells(lstrow, "b").Value = Text1.Text YSheet.Cells(lstrow, "c").Value = Text2.Text YSheet.Cells(lstrow, "d").Value = Text3.Text YSheet.Cells(lstrow, "e").Value = Text4.Text YSheet.Cells(lstrow, "f").Value = Text5.Text YSheet.Cells(lstrow, "g").Value = Text6.Text Text1.Text = "" Text2.Text = "" Text3.Text = "" Text4.Text = "" Text5.Text = "" Text6.Text = "" MsgBox ("ÊãÊ ÇáÚãáíÉ ÈäÌÇÍ") End If End Sub Private Sub Command2_Click() 'ودا كود اظهار برنامج الاكسيل بردو غيرنا اللي اشرنا ليه فقط YXL.Visible = True End Sub Private Sub Command3_Click() ' ودا لاخفاء برنامج الاكسل YXL.Visible = False End Sub Private Sub Command4_Click() 'لحفظ البرنامج المفروض المتغير يكون شغال بس مش عارف سبب المشكلة ايه حاليا فقلت اجرب الكود العادي اشتغل تمام مشي حالك 'åäÇ ãÔ ÚÇÑÝ ÇáãÊÛíÑ åäÇ ÞÝÔ ãÚÇíÇ æãÔ ÚÇíÒ íÍÝÙ ÞáÊ ÇÌÑÈ ÇáßæÏ ÇáÚÇÏí ÇÔÊÛá ÞáÊ Òí ÇáÝá 'YWB.save ActiveWorkbook.save End Sub Private Sub Command5_Click() 'وطبعاخروج YXL.Quit Set YXL = Nothing End End Sub Private Sub Form_Load() 'هنا بنستدعي ملف الاكسيل من نفس مسار البرنامج بتاعنا ونفتحه YXL.Workbooks.Open App.Path & "/aseel.xlsx" 'اخفاء البرنامج بعد فتحه طبعا YXL.Visible = False 'هنا بقي قولنا له ان يخلي Ysheet دي تبقى الشيت الاول والاكس شيت تبقي الشيت التاني Set YSheet = YXL.Worksheets(1) Set XSheet = YXL.Worksheets(2) عادي ليبل وبياخد بياناته من خليه معينه Label7.Caption = YSheet.Range("a1").Value Label8.Caption = YSheet.Range("a2").Value With Combo1 'ودا ا لكمبوبوكس بندرج فيه بيانات الصف b For Each Data In YSheet.Range("b6:b" & YSheet.Cells(Rows.Count, "b").End(xlUp).Row) .AddItem Data Next End With End Sub Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer) ودا بقي عشان لما تدوس علي علامة الاكس فوق ميخرجشي من البرنامج ويسيب ملف الاكسيل مفتوح ومخفى '' YXL.Quit Set YXL = Nothing End End Sub وبكدا نكون انتهينا من وضع الاكواد اظن الكل واخد باله انه مفيش جديد وهو دا بالتحديد مفيش جديد كل اللي عملناه واحد تايه وعرفنا السكه خلاص وبعدين محدش ينسى يعمل ملف اكسيل اه بعد دا كله يجي حد يقولي البرنامج مش شغال ليه اقوله فين ملف الاكسيل بعد الاطلاع علي البرنامج هيجي واحد يقولي ايه القلب الجميل اللي علي الفورم دا اللي مكان السهم اهو دا من ضمن اللمسات الجمالية وبيتعمل ازاي يامعلم الشرح بسيط ف الصورة معلش بدل ما اكتب الماوس كتبت الموس شغال بقى اعذروني انا بعمل الشرح في وقت قياسي وانا شغال مرفق البرنامج ومعاه القلب عشان تعملوه مكان السهم يارب اكون وصلت المعلومة صح واي خطأ منى فدا لجهلى اعذروني منتظر الردود علي فكرة الدرس دا تقريبا بنسبة كبيرة يعتبرحصرى لمنتدى اوفيسنا انا بحثت عن ربط الفيجوال بالاكسيل كثيرا وكثيرا وكود من هنا وكود من هنا حتى اكتملت الصورة امامي وتوصلت لهذا والحمد لله مع تحياتي ياسر العربي يتبع ربط الفيجوال بالاكسل.rar