ناصرالمصرى

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

بارك الله فيك يا أستاذ احمد تمام معاليك .... سؤال أكثر تحديدا هذا بعد إذن حضرتك .... هل صندوق الزمالة الــ 7% وصندوق الرعاية العمالية الــ 5% ينطبق عليهم نص الفقرة الثالثة من المادة رقم 13 ..... برجاء الافاده وجزاكم الله خيرا

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

أخى وأستاذى الفاضل / العيدروس السلام عليكم ورحمة الله وبركاته بداية جزاكم الله خيرا وبارك فيكم **** فى الحقيقة لقد أستهوانى هذا الموضوع الشيق ولإحتياجى لهذا العمل لأكثر من ورقة عمل مختلفة من حيث التصميم كهدف ومصدر البيانات واحد Option Base 1 Private Const Mycount As Integer = 10 Dim My_Rng As Range Private Sub CheckBox1_Click() With CheckBox1 If .Value = True Then .Caption = "إلغاء تحديد الكل" PrintOut.Enabled = False Un_Lo True Else PrintOut.Enabled = True .Caption = "تحديد الكل" Un_Lo False End If End With End Sub Private Function Un_Lo(Bl As Boolean, Optional Ck As Boolean) Dim Ch_Comb As Control For Each Ch_Comb In Me.Frame2.Controls If TypeOf Ch_Comb Is MSForms.CheckBox Then If Ck Then If Ch_Comb.Value = True Then Un_Lo = 1 End If Else If Ch_Comb.Value <> Bl Then Ch_Comb.Value = Bl End If End If End If Next Ch_Comb End Function Private Sub CommandButton4_Click() Dim Chck As Control Dim Sh As Worksheet Set Sh = Sheets("ورقة2") With Me If Un_Lo(True, True) = 1 Then For Each Chck In Me.Frame2.Controls If TypeOf Chck Is MSForms.CheckBox Then If Chck.Value = True Then Sh.[CA12].Value = Chck.Caption Sh.PageSetup.PrintArea = "$A$1:$L$50" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If End If Next Chck Un_Lo False, False Else Sheets("ورقة2").Select Sh.PageSetup.PrintArea = "$A$1:$L$50" ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True End If End With Set Sh = Nothing End Sub Private Sub CommandButton6_Click() Application.Visible = True Unload Me End Sub Private Sub Label6_Click() End Sub Private Sub PrintOut_Change() Sheets("ورقة2").[CA12].Value = PrintOut.Text ''''''''''' End Sub Private Sub UserForm_Initialize() Dim Sh As Worksheet Dim Ar Set Sh = Sheets("الرئيسية") Set My_Rng = Sh.Range("f8:f2500") Ar = Ali_Def(My_Rng) Dim MyTop As Integer, i As Integer Dim MyCBox As Control Dim MyCmBox As Control CheckBox1.Caption = "تحديد الكل" MyTop = 0 For i = 1 To UBound(Ar) Set MyCBox = Frame2.Controls.Add("Forms.CheckBox.1") With MyCBox .Move 200, MyTop, 200, , True .Alignment = 0 .Font.Bold = True .Font.Size = 14 .Caption = Ar(i) .Value = False .Name = "A" & i .TextAlign = fmTextAlignRight End With MyTop = MyTop + 30 Next With Me If MyTop > .Height Then .Frame2.ScrollHeight = (UBound(Ar)) * 30 .Frame2.ScrollBars = fmScrollBarsVertical Else .Frame2.ScrollBars = fmScrollBarsNone End If Me.PrintOut.List = Ali_Def(My_Rng) End With End Sub Function Ali_Def(Rng) As Variant Dim Cell As Range Dim Ar() Dim Ob_A Dim i Dim Vr With Sh On Error Resume Next End With Set Ob_A = CreateObject("Scripting.Dictionary") For Each Cell In Rng If Not Ob_A.Exists(Cell) Then Ob_A.Add Cell, Cell.Address End If Next For Each Vr In Ob_A.Keys If Not Vr = "" Then i = i + 1 ReDim Preserve Ar(1 To i) Ar(i) = Vr End If Next If i Then Ali_Def = Ar() End If End Function فكرت فى فكرة لم أستطع القيام بها وهى أننى قمت بإنشاء فورم بإستخدام الصفحات المتعددة ( MultiPage ) فكيف يمكن تطويع هذا الكود لأكثر من ورقة من خلال صفحات ( MultiPage ) **** أليك أخى الفاضل هذا المرفق لتوضيح ما أريد تحقيقة ***** برجاء اللإطلاع والإفادة وجزاكم الله تعالى خيرا بيان الحالة-الاستاذ العيدروس.xlsb.xlsm

كفيت ووفيت أخى وأستاذى العيدروس بارك الله فيكم وفى أولادكم وجزاكم الله خيرا

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

السلام عليكم أخى وإستاذى / العيدروس فضلا لا أمرا كيف يمكن تعديل هذا الجزء من الكود لكى تظهر الاسماء بشكل كامل وواضح كما يقولون على سطر واحد لان الاسماء تظهر فى الــ Frame على سطرين خاصة الاسماء الخماسية فكلما تم تكبير البنط يتم تداخل الاسماء فى بعضها أما إذا تم تصغير البنط الى 4 على سبيل المثال تظهر الاسماء كاملة لكنها صغيرة جدا For i = 1 To UBound(Ar) Set MyCBox = Frame2.Controls.Add("Forms.CheckBox.1") With MyCBox .Move 110, MyTop, 90, , True .Alignment = 0 .Font.Bold = True .Font.Size = 6 .Caption = Ar(i) .Value = False .Name = "A" & i .TextAlign = fmTextAlignRight End With MyTop = MyTop + 24 Next With Me If MyTop > .Height Then .Frame2.ScrollHeight = (UBound(Ar)) * 24 فماذا يفعل أصحاب النظر الضعيف **** وما المقصود بــالرقم 24 فهل يمكن تعديل خصائص الفوروم ليتلائم مع الجميع شاكر فضل حضرتك وجزاكم الله خيرا

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

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

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

فضلك الله أخى الكريم و شاكر فضل حضرتك فى بعض الاحيان لا تحتوى بعض الاعمدة على قيم هنا تأتى النتيجة بأصفار فكيف يمكن أن نستبدلها بفراغ فى حالة عدم إحتواء أي عمود على قيم؟ شكرا لك أستاذ على وجزاكم الله خير أخى الكريم الاستاذ / على أعتذر للعودة مرة أخرى للموضوع بعد طلب الإذن ماذا لو أردت قسمة ناتج الجمع ÷ 3 ثم ضرب × 22% على نفس المثال المرفق بعاليه النتيجة المتوقعه = 124087.11 شاكر فضل حضرتك وجزاكم الله خيرا

السلام عليكم ورحمة الله وبركاته أرغب فى معادلة لجمع النطاق المبين بالورقة 1 ووضع النتائج فى الورقة 2 على خليتين أحدهما للقرش والاخرى للجنيهات شاكر فضل حضراتكم وجزاكم الله خيرا جمع نطاق من ورقه الى اخرى.xlsx

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

جزاكم الله خيرا على الرد والمشاركة مزيد من التوضيح بداخل هذا المثال لمعرفة ما أعنيه شاكر فضل حضرتك وجزاكم الله خيرا تحويل.xlsm

السلام عليكم ورحمة الله وبركاته لديّ هذا الكود الذي يُحول المعادلات إلى قيم وهو من إبداعات عمالقة هذا المنتدى إنه يعمل بشكل رائع مع البيانات الصغيرة لكنه بطيء جدا مع البيانات الكبيره فهل من سبيل لجعله أسرع *** شاكر فضل حضراتكم وجزاكم الله خيرا Sub test() Dim r As Long Application.ScreenUpdating = False r = Range("A" & Rows.Count).End(xlUp).Row Range("a2:y2").AutoFill Range("a2:y" & r), xlFillDefault Range("a3:y" & r).Value = Range("a3:y" & r).Value Range("ca2:cy2").AutoFill Range("ca2:cy" & r), xlFillDefault Range("ca3:cy" & r).Value = Range("ca3:cy" & r).Value Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاته لقد أمضيت وقتًا طويل في محاولة معرفة ذلك بمفردي واستكشاف خيارات مختلفة ولكن لسوء الحظ. لذلك يُرجى مشاهدة ورقة الاخراج المطلوب مرة أخرى **** شاكر فضل حضراتكم وجزاكم الله خيرا Example+111.xlsb.xlsm

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

السلام عليكم ورحمة الله وبركاته تحياتى للجميع وكل عام وحضراتكم بخير لديّ هذا الكود الذي ينسخ نطاقًا محددا من الأعمدة مع جميع التنسيقات من ورقة العمل الرئيسية إلى ورقة العمل الجديدة التي سيتم نسخ نطاق البيانات إليها مع إدراج خمسة صفوف فارغة بعد كل 25 صفًا لكنني أواجه صعوبة في إضافة بعض الاكواد التي يجب تضمينها فى هذا الكود للحصول على النتائج المرجوة في الصفوف الخمسة التي تم إدراجها حيث توقف تركيزى وتفكيرى عند هذا الحد من كتابة هذا الكود الذى يعمل بشكل جيد جدا عند هذة المرحلة لذلك أطلب من حضراتكم المساعدة فى إستكمال ما أريد تحقيقة فى هذا الموضوع حيث أحتاج الى **** إضافة صيغ الإجماليات بعد كل 25 صفًا في الصف الأول المدرج **** إضافة بعض السلاسل النصية كتوقيعات المسؤولين مثل ( أوفسينا - أوفسينا 1 - أوفسينا 2 - أوفسينا 3 - أوفسينا 4 ) في أسفل الجداول مباشرة في الصف الثاني المدرج . **** إضافة صيغ الإجماليات السابقة ( جملة ماقبله ) في الصف الخامس المدرج . أعلم جيدا أن كتابة كود يحتاج الى تركيز غالى وينبغى رفع موضوع لكل نقطة من النقاط الثلاثة المطلوب تحقيقها ولكن لكى تكمتل فكرة الموضوع أردت أن يكونوا فى موضوع واحد ... آمل أن أحصل على مساعدة حضراتكم فى هذا الموضوع لقد أرفقت عينة من المصنف تبين بوضوح ما أحاول تحقيقه في ورقة الإخراج المطلوب بعد إضافة الأكواد المتوقعة من حضراتكم شاكر فضل حضراتكم وجزاكم الله خيرا. Example.xlsb.xlsm

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

السلام عليكم ورحمة الله وبركاته ارجو من حضراتكم تعديل المعادلة المبينة بالخلية E2 على النحو المبين بالمرفق التالى شاكر فضل حضراتكم *** وجزاكم الله خيرا اوفسينا.xlsx

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

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

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

أخى الفاضل الاستاذ / فضل حسين بداية جزاكم الله خيرا وبارك فيكم ولا داعى إطلاقا على تقديم أى إعتذار العكس تماما أنا من يجب تقديم الاعتذار لأخذ جزء من وقتكم الثمين فجزاكم الله تعالى عنى خير الجزاء اعتقد أن هناك حلقة تكرارية بهذا السطر من الكود من بداية الصف الثامن وحتى الصف الــ 500 For i = 8 To 500 كيف يمكن تغيير هذا السطر لنجعله الى أخر صف به بيانات أو ماهى الجملة التى يجب تغييرها أو ماهو المقصود بالرقم 500 أعتذر لجهلى فى هذه النقطة ***** شاكر فضل حضرتك وجزاكم الله خيرا

للرفع