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

وعليكم السلام جرب الكود التالي Sub Test() Dim myFile As String myFile = ThisWorkbook.Path & "\" & Range("C4").Text & "-" & Range("C6").Text & ".pdf" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=myFile MsgBox "Done...", 64 End Sub

لمزيد من التميُّز احي ياسر انظر الى الورقة salim من هذا الملف تم تصحيح المعادلات في الورقة الاولى male_femel_macro.rar

أخي الكريم ساديب يرجى تغيير اسم الظهور للغة العربية والإطلاع على التوجيهات في الموضوعات المثبتة في صدر المنتدى (بالله عليكم التزموا بالتعليمات .. والكلام موجه للجميع وليس لشخص واحد فقط) أخي الغالي أبو عبد الرحمن اقتراحك رائع جداً ولكن نحن نتعامل مع واقع الملف ومن الملف يوجد عمود يحدد النوع ، إذاً ليست القضية في المذكر والمؤنث مشكلة .. تكون مشكلة وقضية حينما يطلب أحدهم من الإكسيل تخمين النوع (ودا ساعتها نديله على نافوخه .. هو مفكر الإكسيل سعادته سجل مدني !!) أخي الحبيب سليم راجع ملفك فالنتائج غير مكتملة نظراً لأن المعادلات ينقصها رقم 0 بجانب C10 لتصبح C100 والمعادلات في العمود H معادلات صفيف يبدو أنك نسيت الضغط على المفاتيح بشكل صحيح ..عموماً هي هفوات بسيطة ولكن المعادلات رائعة وفي منتهى الجمال وتؤدي الغرض وإثراءً للموضوع يمكن استخدام الكود التالي (مع العلم أن هناك طرق أخرى كالفلترة أو استخدام المصفوفات .. ولكن استخدمت هنا الحلقات التكرارية .. تقليدي في الموضوع) Sub Test() Dim Lr As Long, lastMale As Long, lastFemale As Long, I As Long Application.ScreenUpdating = False With ActiveSheet .Range("H3:K1000").ClearContents Lr = .Cells(Rows.Count, 2).End(xlUp).Row For I = 3 To Lr If .Cells(I, 3).Value = "ذكر" Then lastMale = .Cells(Rows.Count, "H").End(xlUp).Row + 1 .Range("H" & lastMale).Value = .Cells(I, 2).Value .Range("H" & lastMale).Offset(0, 1).Value = .Cells(I, 4).Value ElseIf .Cells(I, 3).Value = "انثى" Then lastFemale = .Cells(Rows.Count, "J").End(xlUp).Row + 1 .Range("J" & lastFemale).Value = .Cells(I, 2).Value .Range("J" & lastFemale).Offset(0, 1).Value = .Cells(I, 4).Value End If Next I End With Application.ScreenUpdating = True End Sub تقبلوا جميعاً تحياتي

السلام عليكم ورحمته الله وبركاته طلب لاخى الفاضل الاستاذ / ناصر المصرى أحببت أن أضع هذا المرفق بموضوع مستقل للإفادة وسهولة البحث المرفق لحساب الدمغه العادية وفقا لنص المادة رقم 79 من القانون رقم 111 لسنة 1981 بالمعادلات والاكواد وبالطريقة المعتادة وعلى طريقة فصل المبلغ لخليتين أحدهما للقروش والاخرى للجنيهات لاتنسوا الاعفاءات المقررة بقوانين ثم توضع هذة المعادلات او الكود المشار اليه بالمرفق على صافى المبلغ قبل مبلغ الــ 50 جنيها المعفاة ولاتنسونا من دعائكم **** جزاكم الله خيرا **** وكل عام انتم بخير حساب الدمغه العادية ق 111 لسنة 1981 بالمعادلات والدلات المعرفة + التطبيق - سعيد بيرم.rar

أخي العزيز / حسين 22 هذا فورم أستاذنا القدير عبد الله باقشير حفظه الله إن شاء الله يلبي طلبك والعفو amn2016.rar

السلام عليكم بعد إذن السادة الزملاء الافاضل اخى ناصر تفضل ما طلبت " بموديول عادى " Public Function biram(X) N = Int(X) If X > 50 Then result = (X - 50) * 0.006 If X > 250 Then result = 1.2 + (X - 250) * 0.0065 If X > 500 Then result = 2.825 + (X - 500) * 0.007 If X > 1000 Then result = 6.325 + (X - 1000) * 0.0075 If X > 5000 Then result = 36.325 + (X - 5000) * 0.008 If X > 10000 Then result = 76.325 + (X - 10000) * 0.003 biram = result End Function وضع هذه المعادلة بالخلية C1 ثم إسحب لاسفل على اعتبار ان القيمة المعنية بحساب الدمغه العادية بالخلية A1 ثم قارن بين الكود المشار اليه وبين المعادلة المشار اليها حيث تم تصويب المعادلة بمعرفتى وفقا لنص المادة رقم 79 من قانون 111 لسنة 1981 ستجد أن جميع العمليات الحسابية مطابقة =ROUND(biram(A1);1) دائما فى خدمتكم ***** وجزاكم الله خيرا

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

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

اللهم امين *** اللهم امين *** اللهم امين وتقبل الله منك اخى الحبيب ابو البراء صالح الاعمال

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

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

اخوانى الأعزاء واثراءا للموضوع Private Sub mh() m = 2: n = 2 For R = 3 To 12 If Cells(R, 3) = "ÐßÑ" Then m = m + 1 Range("A" & R).Range("b1:d1").Copy Range("h" & m).PasteSpecial xlPasteValues Range("g" & m) = m - 2 Application.CutCopyMode = False ElseIf Cells(R, 3) = "ÇäËì" Then n = n + 1 Range("A" & R).Range("b1:d1").Copy Range("k" & n).PasteSpecial xlPasteValues Range("g" & n) = (n - 2) Application.CutCopyMode = False End If Next End Sub abo_abary_Book1.rar

أخى ناصر السلام عليكم ورحمته الله وبركاته غالى والطلب رخيص وبعد إذن اخى الحبيب / ابو البراء قم بوضع المعادلة التالية بالخلية F1 خانة القروش =CEILING(ROUND(MOD(biram(C3+B3/100);1);2);0.05)*100 وهذه المعادلة بالخلية G1 خانة الجنيهات **** ثم اسحب لاسفل لكلا المعادلتين =INT(ROUND(biram(C3+B3/100);1)) دائما فى خدمتكم ***** جزاكم الله خيرا وبارك فيكم وكل عام أنتم جميعا بخير

تطبيق Access Db ولكنه كباقي التطبيقات يفتح الجداول فقط

جرب الكود التالي لاستعادة جميع الأشرطة (الوضع الافتراضي) Sub ResetAll() Dim myCommandBar As CommandBar For Each myCommandBar In Application.CommandBars If myCommandBar.Type = msoBarTypePopup Then myCommandBar.Reset myCommandBar.Enabled = True End If Next myCommandBar End Sub الكود مقتبس من مكتبة الصرح ... ويوجد الموضوع في الموضوعات الحالية في المنتدى قمت بوضع رد ليظهر في الصفحة الأولى ابحث عن كلمة "استعادة"

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

يمكن ان يكون الحل هـنا male_femel.rar

حياك الله أخي م/هاني أحب التأكيد عليك بضرورة إجراء مزيد من التجارب على ملفي الأخير حتى تطمئن للنتائج وعند ظهور أي خلل إرجو موافاتي بالمدخلات التي حدث عندها الخلل رجاء تعديل الكود تقبل تحياتي

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

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

اسمح لي أخي الحبيب أبو عبد الرحمن بتعديل طفيف بحيث لو كانت الخلية فارغة يعطي فراغ ، وبدلاً من أن تقوم بعملية التقريب في المعادلة تم إدراجها في الدالة المعرفة Public Function Biram(X) Dim N As Variant, Result As Variant If IsEmpty(X) Then Biram = "": Exit Function N = Int(X) If X > 50 Then Result = (X - 50) * 0.006 If X > 250 Then Result = 1.2 + (X - 250) * 0.0065 If X > 500 Then Result = 2.825 + (X - 500) * 0.007 If X > 1000 Then Result = 6.325 + (X - 1000) * 0.0075 If X > 5000 Then Result = 36.325 + (X - 5000) * 0.008 If X > 10000 Then Result = 76.325 + (X - 10000) * 0.003 If IsNumeric(Result) Then Biram = Round(Result, 2) End Function تقبل تحياتي

ربما يفيد هذا الملف بدون VBA True_vlookup.rar

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

تم العمل على الملف كما تريد ترحيل عمود الى عمود وتفريغ الاولsalim.rar

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

يمكنك تصفح هذا القسم به حوالي 500 موضوع عن الدوال فقط http://www.officena.net/ib/forum/50-قسم-دوال-الاكسيل-الجاهزة-built-in-functions/ أيضا هناك العديد من المواضيع يمكنك الوصول اليها عن طريق البحث فى الموقع تتعلق بشرح الدوال بعضها بالفيديو مثال

السلام عليكم أخي لابد من وجود صفحة خاصة بالطباعة أنشأ صفحة و سمها بأي إسم مثلا AAAAA ثم أكتب عناوين الأعمدة في المكان الذي تريده مثلا في الخلية A4 تكتب المادة في الخلية B4 تكتب الكمية في الخلية C4 تكتب سعر الوحدة في الخلية D4 تكتب الإجمالي ثم في الفورم تنشأ زر و تكتب الكود التالي Sheetts("AAAAA").Range("A5").Resize(ListBox1.ListCount, 4).Value = ListBox1.List Sheetts("AAAAA")..PrintOut

أخي الكريم يوجد خاصية طباعة الجزء المحدد من الشيت .. قم بتحديد الجزء المراد طباعته ثم اضغط على Ctrl + p لإظهار نافذة الطباعة واختر الأمر Print Selection أي أن الأمر فيه مرونة ...

إخواني الكرام إليكم الملف يعمل على النسختين 32 بت و 64 بت أرجو أن تستفيدوا منه .. تقبلوا وافر تقدير واحترامي Codes Library v1.9.7.rar

السلام عليكم اعداد تقرير من نطاق معين اتوماتيكيا عن طريق فورم لاختيار رؤوس الاعمدة التي تريده في التقرير ما عليك سوى تغيير اسم الورقة والعمود الذي يعين آخر صف في النطاق والنطاق هنا: Private Sub kh_MyRngSet() Dim Last As Long '======================== ' تعيين النطاق ويشمل رؤوس الاعمدة With Sheets("قاعدة البيانات") Last = .Range("C" & .Rows.Count).End(xlUp).Row Set MyRng = .Range("A2:Z" & Last) End With '======================== Num = MyRng.Columns.Count End Sub وتعيين اول صف في ورقة التقرير هنا: '======================== ' اول صف للتقرير Const iRow As Integer = 3 '======================== خبور خير اعداد تقرير حسب اختيار الاعمدة اتوماتيكيا.rar

هذه قاعدة بيانات مفتوحة بالسورس كود هي قاعدة بيانات أجنبية وجدتها في إحدى المنتديات الأجنبية مع العلم أنني الأن أحاول وضعها بقوائم عربية أتمنى من الجميع الاستفادة منها program.rar

اخي الكريم Ahmadb53 السلام عليكم ورحمة الله وبركاتة هذا برامج لاحد الاعضاء لا اذكر اسمة الله يجزية خير ويجعلة في ميزان اعماله . مع تحياتي SAJSMH Albayan_للمحاسبة.rar

السلام عليكم الاخ الفاضل/ خالد القدس-------- حفظه الله ولك امثال دعائك اضعاف مضاعفة تقبل شكري وتقديري ============================= الاخ الفاضل/ obad65-------- حفظه الله تقبل شكري وتقديري ============================= الاخ الفاضل/ احمد-------- حفظه الله ولك امثال دعائك اضعاف مضاعفة تقبل شكري وتقديري ============================= الاخ الفاضل/ قصي-------- حفظه الله تم التغيير بحيث انه يتم لصق البيانات بثلاثة معايير لصق عرض الاعمدة لصق التنسيقات لصق القيم يمكنك حذف مالا تريده ما عدى القيم طبعا في الكود التالي: Private Sub Kh_Start(iColumn As Integer) Dim RCount As Long, C As Integer C = Cells(iRow, Columns.Count).End(xlToLeft).Column + 1 With MyRng RCount = .Rows.Count .Cells(1, iColumn).Resize(RCount, 1).Copy ' لصق عرض الاعمدة Cells(iRow, C).PasteSpecial xlPasteColumnWidths ' لصق الفورمات Cells(iRow, C).PasteSpecial xlPasteFormats ' لصق القيم Cells(iRow, C).PasteSpecial xlPasteValues Application.CutCopyMode = False End With End Sub تقبل شكري وتقديري خبور خير اعداد تقرير حسب اختيار الاعمدة اتوماتيكيا1.rar

السلام عليكم ورحمة الله وبركاته اخي سعد على حسب مافهمت تم اضافة خانة جديدة اسمها " ملاحظات " وبالنسبة للصافة " قم باضافة المعادلات في صفحة الكشف ولن تشطب كما في السابق وجزاك انت وباقي المسلمين خيرا وبارك الله فيك يا عمنا العزيز الحج ابو عبدالله وكل عام وانت وباقي المسلمين في الف خير كشف حساب.rar

قاعدة بيانات للموظفين ........ المرفقات EMPlwee.rar