أكاديمية الصقر للتدريب

لوحة التميز الأسبوعي
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
العضو المتميز المشرف المتميز المراقب المتميز المدير المتميز الموضوع المتميز القسم المتميز
ashraf_hertlion hassona229-- لا تميز خلال هذه الفترة YasserKhalil مطلوب تعديل الكود للطباعة اكسيل اسئله واجابات


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





استاذ  سليم  احتاج تعديل فى كود من ابداعك

استاذ salim احتاج مساعدة من حضرتك هذا الكود من تصميمك وابداعك احتاج تعديل من حضرتك على الكود احتاج تعديل تم عمل قائمة ..



08-08-2020 08:08 مساء
abouelhassan
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس : ذكر
يتابعهم : 6
يتابعونه : 0
قوة السمعة : 418
 offline 

استاذ  salim  احتاج مساعدة من حضرتك هذا الكود من تصميمك وابداعك احتاج تعديل من حضرتك على الكود

احتاج تعديل تم عمل قائمة منسدلة بها 3 جمل-كلمات

او جملة جمع الكل وفى هذه الحالة الكود يظل كما هو حاليا يؤدى مهمته الحالية

2-الارقام السالبة اريده ان يستدعى الارقام التى اقل من صفر

3-الارقام الموجبة اريده ان يستدعى الارقام اكبر من صفر

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

مع خالص دعائى وشكرى وعرفانى بالجميل اخيكم باحترام
 

Sub Trasfer_data_Special()
  Dim R          As Worksheet, Act_sh As Worksheet
  Dim k%, col%, Ro%
  Dim Max_ro%, x%, y%
  Dim Bol        As Boolean
  Dim ST_Dat     As Date
  Dim End_Dat    As Date
  Dim My_sum#
  Dim Mot$
  
Mot = "الاجمالى"

Set R = Sheets("Report_Youmi")
Ro = R.Cells(Rows.Count, 1).End(3).Row
R.Range("C3").CurrentRegion.Resize(Ro - 1).ClearContents
R.Cells(3, 9).Resize(Ro - 2).ClearContents
ST_Dat = Application.Min(R.Range("I2:J2"))
End_Dat = Application.Max(R.Range("I2:J2"))

For k = 3 To Ro - 2

      Bol = Application.Evaluate _
        ("ISREF('" & R.Range("A" & k) & "'!A1)")
    If Bol Then
        Set Act_sh = Sheets(R.Range("A" & k) & "")

        Max_ro = Act_sh.Cells(Rows.Count, 1).End(3).Row
        For y = 3 To 7
            For x = 5 To Max_ro

                If CDate(Act_sh.Cells(x, 1)) >= ST_Dat And _
                   CDate(Act_sh.Cells(x, 1)) <= End_Dat And _
                   Act_sh.Cells(x, 2) <> Mot Then
                   My_sum = My_sum + IIf(IsNumeric(Act_sh.Cells(x, y + 2)), _
                     Act_sh.Cells(x, y + 2), 0)

               End If
               
            Next x
           R.Cells(k, y).Value = IIf(My_sum = 0, "", My_sum): My_sum = 0
       Next y
    End If
Next k
'+++++++++++++++++++++++++++++++++

R.Cells(Ro - 1, 3).Resize(, 5).Formula = _
"=if(COUNT(C$4:C$39)>0,SUM(C$4:C$39),"""")"
R.Cells(Ro, 3).Resize(, 5).Formula = _
"=IF(COUNT(C$7:C$17)>0,SUM(C$7:C$17),"""")"

R.Cells(4, 9).Resize(Ro - 3).Formula = _
"=IF(COUNT($C4:$G4)>0,SUM($C4:$G4),"""")"

R.Range("A3:I" & Ro).Value = _
R.Range("A3:I" & Ro).Value
End Sub


 
 
 
  My_Repport_Updated.xlsm   تحميل xlsm مرات التحميل :(1)
الحجم :(88.795) KB


08-08-2020 10:28 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif استاذ  سليم  احتاج تعديل فى كود من ابداعك
تم معالجة الأمر
 
 
  My_Repport_Negatve.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(94.693) KB


08-08-2020 11:12 مساء
مشاهدة مشاركة منفردة [2]
abouelhassan
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس : ذكر
يتابعهم : 6
يتابعونه : 0
قوة السمعة : 418
 offline 
look/images/icons/i1.gif استاذ  سليم  احتاج تعديل فى كود من ابداعك
ربنا يسترك ويحفظك ويبارك فيك وينجيك اللهم امين
معلش فى مشكلة بسيطة فى الجمع بيجمع كل الاعمدة فى عمود الاستدعاء مختلف عن الشيت
ارفقت لحضرتك المشكلة
جمع الكل مضبوط اما جمع السالب فيجمع الخمسة اعمدة فى عمود وكذالك استدعاء الارقام الموجبة
ربنا يسترها معاك دائما يارب زى ما بتساعد اخوانك يارب
 
 
  My_Repport_Negatve.xlsm   تحميل xlsm مرات التحميل :(0)
الحجم :(91.853) KB


09-08-2020 04:01 مساء
مشاهدة مشاركة منفردة [3]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif استاذ  سليم  احتاج تعديل فى كود من ابداعك
تم التعديل على الملف
الكود يعمل بمجرد اختيار نوع الحساب من الكومبوبوكس
مع امكانية زيادة عدد الصفحات وتسميتها كما تريد
"بشرط عدم التسمية باسم يبدأ بـــ  "Rep"
و أن تكون الصفحة الجديدة التي تريد اضافتها بنفس التنسيق كما الشيتات الباقية من حيث تصميم الجداول (بداية الجول ونهايته)
اسماء الشيتات  تظهر اوتوماتيكياً في العامود الأول (قبل كلمة   TOTAL)

الملف مرفق
 
 
 
  My_New_Repport.xlsm   تحميل xlsm مرات التحميل :(6)
الحجم :(89.583) KB


09-08-2020 04:48 مساء
مشاهدة مشاركة منفردة [4]
abouelhassan
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس : ذكر
يتابعهم : 6
يتابعونه : 0
قوة السمعة : 418
 offline 
look/images/icons/i1.gif استاذ  سليم  احتاج تعديل فى كود من ابداعك
ربنا يحفظك يارب ويديك الصحة والعافية ويبارك لك في اسرتك الكريمة
معلش اين الملف استاذى 
ربنا يكرمك يارب ويديك على نيتك الطيبة يا طيب سترك وحفظك الله
احترام وتقدير من اخيك

09-08-2020 07:20 مساء
مشاهدة مشاركة منفردة [5]
abouelhassan
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس : ذكر
يتابعهم : 6
يتابعونه : 0
قوة السمعة : 418
 offline 
look/images/icons/i1.gif استاذ  سليم  احتاج تعديل فى كود من ابداعك
افكار عصرية رائعة ربنا يرضى عنك وعن اسرتك ويحفظك اللهم امين يارب
معلش استاذى كان فى عمود اخر الجدول بعد M5 يجمع افقى
حاولت اعمله بشكل يدوى فى صورة sum بس الكود كله توقف وكان بعد total كان فى تجميع افقى لعدد معين من الخلايا الراسية
ربنا يرضى عنك جميل جدااااااااااا اسماء الشيتس اوتوماتيك التجميع مضبوط كلو جميل 
تسلم ايدك يارب يكرمك اللهم امين يارب 


تم تحرير المشاركة بواسطة :abouelhassan
بتاريخ:09-08-2020 07:39 مساء


09-08-2020 08:19 مساء
مشاهدة مشاركة منفردة [6]
abouelhassan
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 26-05-2020
رقم العضوية : 19295
المشاركات : 184
الجنس : ذكر
يتابعهم : 6
يتابعونه : 0
قوة السمعة : 418
 offline 
look/images/icons/i1.gif استاذ  سليم  احتاج تعديل فى كود من ابداعك
تسلم ايدك تمام التمام تم عمل كل شى ربنا يرضى عنك استاذى يارب 
ويبارك لك ان شاء الله والله ربنا هيراضيك
ينقسنى شئ واحد اذا كانت الخلايا =0 تظل فارغة 
كان الكود القديم المسئول عنها

R.Cells(k, y).Value = IIf(My_sum = 0, "", My_sum): My_sum = 0

اشكرك ربنا يحفظك يا رب




الكلمات الدلالية
استاذ  ، سليم ،  احتاج ، تعديل ، ابداعك ،


 










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

الساعة الآن 02:45 صباحا