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

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

السلام عليكم ورحمة الله تعالى وبركاته أحبائي وأساتذتي الأفاضل أقدم لك هذه التجميعية البسيطه ليستفيد بها المبتدئ والمحترف تجمعية تحت عنوان تغذية القائمة المنسدلة خاصة بالفورم (ComboBox) بمدى ديناميكي أولا: نقوم بإنشاء فورم وندرج به قائمة منسدلة (ComboBox1) ثانيا : نفتح محرر الاكواد View Code) ثالثا: من نافذه المحرر نختر حدث بداية التشغيل الفورم UserForm_Initialize Private Sub UserForm_Initialize() End Sub نقوم بوضع المتغير التالي الخاص بتحديد ورقة العمل وهم أمر مهم جدا Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select End Sub نأتي الأن إلى الأكواد الخاصة بتغذية القائمة المنسدلة ملاحظه جميع الأكواد الخاصة بالتغذية أنا إخترت العمود الأول وبداية التغذية من الخلية A2 ولكم حرية التغيير الكود رقم 1 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Range("A2", Range("A" & Rows.Count).End(xlUp)).Name = "Dynamic" Me.ComboBox1.RowSource = "Dynamic" End Sub الكود رقم 2 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.RowSource = Range("B2", Range("B65536").End(xlUp)).Address End Sub الكود رقم 3 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.RowSource = ("A2:A") & ws.Cells(Rows.Count, "A").End(xlUp).Row End Sub الكود رقم 4 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.List = Range("A2:A" & Cells(Application.Rows.Count, 1).End(xlUp).Row).Value End Sub الكود رقم 5 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim FR As Integer, LR As Integer With ws LR = .Range("A2").End(xlDown).Row For FR = 2 To LR Me.ComboBox1.AddItem .Range("A" & FR) Next FR End With End Sub الكود رقم 6 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim R As Integer With ws For R = 2 To .Range("A" & .Rows.Count).End(xlUp).Row If .Range("A" & R) <> "" Then Me.ComboBox1.AddItem .Range("A" & R) End If Next R End With End Sub الكود رقم 7 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim LR As Long LR = ws.Cells(Rows.Count, "A").End(xlUp).Row myList = ws.Range("A2:" & "A" & LR) Me.ComboBox1.List = myList End Sub الكود رقم 8 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim LR As Long LR = ws.Range("A" & Rows.Count).End(xlUp).Row Set myList = ws.Range("A2:A" & LR) Me.ComboBox1.List = myList.Value End Sub الكود رقم 9 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim LR As Long With ComboBox1 LR = ws.Cells(Rows.Count, 1).End(xlUp).Row .List = ws.Range(ws.Cells(2, 1), ws.Cells(LR, 1)).Value End With End Sub الكود رقم 10 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim myList As Range For Each myList In ws.Range("A2").SpecialCells(xlConstants) With Me.ComboBox1 .AddItem myList.Value .List(.ListCount - 1, 1) = myList.Offset(0, 1).Value End With Next End Sub الكود رقم 11 Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim i As Integer, iMin As Integer, iMax As Integer iMin = 2: iMax = Columns(1).Find("*", , , , xlByColumns, xlPrevious).Row For i = iMin To iMax ComboBox1.List = Range(Cells(iMin, 1), Cells(iMax, 1)).Value Next i End Sub الكود رقم 12 من إدارة الأسماء نختر جديد الإسم انت حر فيما تختار أنا إخترت MyRange في خانة يشير إلى نقوم بوضع هذه المعادلة =OFFSET(Sheet1!$A$2;;;COUNTA(Sheet1!$A$2:$A$10000);1) في الفورم نقوم بوضع الكود التالي Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Me.ComboBox1.RowSource = "Myrange" End Sub الكود رقم 13 كود تغذية القائمة المنسدلة بدون فراغات Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim cell As Range With ws For Each cell In .Range("A2:A" & .Cells(Rows.Count, "A").End(xlUp).Row) If Not IsEmpty(cell) Then ComboBox1.AddItem cell.Value Next cell End With End Sub الكود رقم 14 كود تغذية القائمة المنسدلة بدون فراغات وبدون تكرار Private Sub UserForm_Initialize() Dim ws As Object Set ws = ThisWorkbook.Sheets(1) ws.Select Dim I As Integer Dim Valeurs As Variant Dim sDic As Object Set sDic = CreateObject("Scripting.Dictionary") With ws Valeurs = .Range("A2:A100").Value For I = LBound(Valeurs) To UBound(Valeurs) If Not IsEmpty(Valeurs(I, 1)) Then sDic(Valeurs(I, 1)) = "" Next I End With If IsArray(Valeurs) Then Me.ComboBox1.List = sDic.keys End Sub وفي الأخير أتمنى هذه التجمعية المتواضعة أن تفيدكم أعرف أن أستاذي القدير حيزعل مني لأني لم أقم بوضع هذه الاكواد في تجمعية مكتبه المنتدى ووضعها في موضوع منفصل حتى يكون هذا الموضوع مرجعا لكل من يريد التعلم بأبسط الطرق أستاذي القدير وحقك عليا تقبلو تحياتي لا تنسونا بخالص دعائكم

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

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

الأخ الحبيب عبد العزيز البسكري جزيت خيراً على مرورك الكريم وعلى دعوتك الطيبة الأخ العزيز أبو قاسم مشكور على مرورك العطر .. وكلماتك الطيبة الرقيقة تقبلوا وافر تقديري واحترامي

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

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

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

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

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

ذكرتني بمثال عندي يحسب حجم البيانات داخل قاعدة البيانات حجم البيانات في البرنامج.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 نفتح نموذج والا نفتح النموذج الثالث

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

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