حماده سعد الله

ممكن ملف الشرح يا أستاذ مجدي

عمل رائع يا أستاذ مجدي يا ريت تكمل جميلك بالملف اللي تم عليه الشرح

3 ساعات مضت, shreif mohamed said:

السلام عليكم 

Sub sh22mar2018()
Dim a, b, c, d  As Long
Dim e As Double
Dim i As Long
a = 16 ' عدد الصفوف المراد طباعتها في الصفحة الواحدة
b = 1 ' بداية من الصف رقم
c = 8 'عدد الاعمدة 
d = 100 ' اجمالي الصفوف في صفحة العمل
e = Application.WorksheetFunction.RoundUp(d / a, 0)
Range("A" & b, Range("A" & a)).Resize(, c).Select
For i = 1 To e
ActiveSheet.PageSetup.PrintArea = Selection.Address
    ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, _
        IgnorePrintAreas:=False
Selection.Offset(a).Select
Next
End Sub

 

شكرا أستاذ شريف لاهتمامك وسأحاول تنفيذ الكود

الأستاذ المحترمali mohamed ali شكرا لسرعة ردك واهتمامك

ولكن ما أقصده عو أنني أريد طباعة صفحة شيت بها مثلا 100 صف و أريد أن يكون بكل صفحة طباعة 26 صف فقط دون زيادة أو نقصان فهل هذا ممكن عن طريق الكود

حتي لا أحتاج إلي ضبط كل صفحة مرارا وتكرارا وخاصة عند زيادة أو نقصان حجم الخط أو ارتفاع الصف

هل يمكن عمل كود لتحديد عدد الصفوف بصفحة الطباعة

بمعني جعل عدد الصفوف 20 صف مثلا بالصفحة الواحدة  عند الطباعة 

وشكرا مقدما أحبابي في الله

في ١٧‏/١٢‏/٢٠١٧ at 15:29, أبوعيد said:

يوجد في الملف شيتين بنفس الاسم (وهذه هي الحيلة التي وضعتها)

شيت1 فيه بياناتك

وشيت1 خالي من البيانات

جرب أن تغير اسم أحد الشيتات ولاحظ النتيجة

الأخ الأستاذ أبو عيد هل يمكنك التعديل علي هذا العمل الرائع بحيث عند قفل الملف لا يظهر الا sheet1 الفارغ حتي وان كان هناك شيتات أخري لا تظهر عند الغلق بتاريخ وشكرا

يا شباب أعتقد طلبي مش صعب قوي أنا عاوز التعديل علي صفحة الشهادة فقط بحيث تتفق مع الشيت اللي أرفقته وفي الشيت المطلوب المجموع فقط لكل ماده أرجوكم

(وقل اعملوا فسيرى الله عملكم ورسوله والمؤمنون)

up

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

59 دقائق مضت, بن علية حاجي said:

السلام عليكم

المرفق الأول ليس فيه ما تقول (برنامج طباعة الشهادات) وهو يحوي 4 دوال مستحدثة لحساب العمر... ولا تنسى إرفاق نموذج للشهادات حسب ما تريده...

بن علية حاجي

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

برنامج شهادات المرحلة الأبتدائية2.rar

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

جعله الله في ميزان حسناته

أطمع في كرمه أو كرم السادة المشرفين في عمل تعديل لهذا العمل الجميل ليتناسب مع شيت درجات المعهد الثانوي الأزهري ولكم مني ومن أسرة المعهد  

الشكر الجزيل

ملحوطة

لا يهمنا سوي المجموع النهائي لكل مادة وإضافة خانة للمجموع

برنامج طباعة الشهادات المدرسية.rar

شيت الدرجات.rar

في ١٣‏/١٠‏/٢٠٠٦ at 02:28, أبو تامر said:

السلام عليكم ورحمة الله وبركانة

 

تحياتى للجمبع

 

برنامج طباعة الشهادات المدرسية للمرحلة الابتدائية

 

ويشمل طباعة كشوف المنادة وكشوف ارقام الجلوس وطباعة الشهادات وايضا كشوف الدور الثانى .

 

الاخت ايناس

 

شكر لك لما قدمت من مساعدات ونماذج ومعلومات ومتابعة حتى تم الانتهاء من هذا البرنامج .

 

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

 

لمحة سريعة عن البرنامج

 

البرنامج ذو شاسة رئيسية سهلة التعامل

 

به مجموعة من الاكواد تحتوى على بعض الاجابات وطلبات الاعضاء السابقة على سبيل المثال لا الحصر

 

يوجد ضمن البرنامج اجابة لسؤال الاخ عادل صادق عن (Title Bar)

 

وايضا حل لمشكلة واجهت الاخ adel123 عن اسخدام ( Shape ) الدوائر الحمراء فى وجود القوائم المنسدلة

 

فأرجو منهما الانتباه لذلك .

 

واترككم مع شرح سريع لطريقة العمل على البرنامج

 

 

 

________________________________.rar

الأستاذ العبقري أبو تامرما أروع هذا العمل 

جعله الله في ميزان حسناتك

أطمع في كرمك في أن تقوم بعمل تعديل لهذا العمل الجميل ليتناسب مع شيت درجات المعهد الثانوي الأزهري ولك مني ومن أسرة المعهد  

الشكر الجزيل

شيت الدرجات.rar

في ٩‏/١٢‏/٢٠١٧ at 06:14, مصطفى محمود مصطفى said:

السلام عليكم ورحمة الله وبركاته

شكرا لكم اساتذة المنتدى الرائع

بحثت عن الحل ووجدته في معادلة للاستاذ الفاضل عبد الله باقشير

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

تحياتي 

 

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

تم التوصل الى حل استدعاء بيانات.rar

شوف كدا أخي هذا ما فهمته منك

نموذج التعديل2.rar

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

أتمني من الله أن أكون استطعت توصيل طلبي هذه المرة

والموديول من أحد خبراء المنتدي

Sub COPY_TO_FILE_ONLY()
    Dim xPath As String
    Dim SH As Worksheet
    xPath = Application.ActiveWorkbook.Path
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
' الشيت الاول
    Set SH = Sheets("كشف 2 ج أدبي مستجد")
        With SH
            .Copy
            Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.ActiveWorkbook.Close False
        End With
        
        
  ' الشيت الثاني
            Set SH = Sheets("كشف المناداة أدبي مستجد")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        With SH
            .Copy
            Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.ActiveWorkbook.Close False
        End With

' الشيت الثالث
    Set SH = Sheets("كشف 2 ج أدبي معيد")
        With SH
            .Copy
            Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.ActiveWorkbook.Close False
        End With
        
' الشيت الرابع
    Set SH = Sheets("كشف المناداه أدبي معيد")
        With SH
            .Copy
            Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.ActiveWorkbook.Close False
        End With
        
        
  ' الشيت الخامس
            Set SH = Sheets("كشف 2 ج أدبي من الخارج")
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
        With SH
            .Copy
            Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.ActiveWorkbook.Close False
        End With

' الشيت السادس
    Set SH = Sheets("كشف مناداه أدبي من الخارج")
        With SH
            .Copy
            Application.ActiveWorkbook.SaveAs Filename:=xPath & "\" & .Name & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled
            Application.ActiveWorkbook.Close False
        End With
        
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

السلام عليكم ورحمة الله وبركاته

أحبائي في الله أريد أن أعرف ماهي كيفية قطع الإرتباطات بملف مرتبط بملف آخر 

علما بأن رسالة قطع الارتباط لا تظهر

rttyt.rar

بارك الله فيك أخي الحبيب الأستاذ / حمادة عمر  وشكرا جزيلا علي هذا المجهود في هذا العمل الرائع

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

في ١٢‏/٤‏/٢٠١٧ at 15:19, حمادة عمر said:

جرب اخي المرفق التالي

وفي انتظار ردك

تقبل خالص تحياتي

 

نسخ شيتات معينة لملف آخر بدون المعادلات وتسميته بتاريخ اليوم.rar

أخي الحبيب الأستاذ حماده عمر  هل يمكنني أن أطلب من حضرتك أن تزيد علي هذا العمل الرائع عند النسخ يقوم بنسخ كل شيت مستقل بنفسه نظام 97/2003وأن يكون كل شيت باسمه ولك عظيم الشكر والتقدير

العلامة الكبير أبو البراء شكرا جزيلا

أصبح الحفظ بصيغة  Exel 97 /2003workbook ولكن ليس في فولدر مستقل 

كما أن الورقة المنسوخة بنفس اسم الورقة المنسوخ منها داخل العمل

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

أرجوأن أكون استطعت توصيل ما أقصده كما أرجوا ألا أكون أثقلت علي حضرتك

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

في ١٥‏/١‏/٢٠١٦ at 10:18, ياسر خليل أبو البراء said:

أخي الكريم ابن الملك

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

عموماً إليك الحل التالي يعتمد على النطاق المحدد ..أي قم بتحديد النطاق أولاً ثم تنفيذ الكود ليتم تصديره إلى مصنف جديد

Sub Copy_Selected_Range_As_New_Workbook()
    Dim a As Range, rng As Range
    
    Application.ScreenUpdating = False
        Set rng = Selection
        ActiveSheet.Copy
        
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        Columns.Hidden = False
        Rows.Hidden = False
        Cells.ClearContents
        
        For Each a In rng.SpecialCells(xlCellTypeVisible).Areas
            Range(a.Address).Value = a.Value
        Next a
        
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\YourFileName.xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
        ActiveWorkbook.Close
    Application.ScreenUpdating = True
End Sub

تقبل تحياتي

 

Export Selected Range To New Workbook YasserKhalil.rar

العلامة الكبير أبو البراء كل عام وحضرتك بألف خير وكل أسرة هذا المنتدي المحترم أرجو من كرمك أن تعدل من هذا الكود لتكون الورقة المنسوخة بنفس اسم الورقة المنسوخ منها ويكون الحفظ بصيغة  Exel 97 /2003workbook وأن تكون في ملف مستقل 

أرجو ألا أكون أثقلت علي حضرتك

في ١٥‏/١٢‏/٢٠١٦ at 21:09, ياسر خليل أبو البراء said:

Sub Copy_Selected_Range_As_New_Workbook()
    Dim a As Range, rng As Range
    
    Application.ScreenUpdating = False
        Set rng = Selection
        ActiveSheet.Copy
        
        If ActiveSheet.FilterMode Then ActiveSheet.ShowAllData
        Columns.Hidden = False
        Rows.Hidden = False
        Cells.ClearContents
        
        For Each a In rng.SpecialCells(xlCellTypeVisible).Areas
            Range(a.Address).Value = a.Value
        Next a
        
        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\YourFileName.xls", FileFormat:=56, CreateBackup:=False
        ActiveWorkbook.Close
    Application.ScreenUpdating = True
End Sub

 

الكود لم يحقق المطلوب أخي وأستاذي 

في ١٥‏/١٢‏/٢٠١٦ at 21:11, ياسر خليل أبو البراء said:

الرابط

عزيزي أبو البراء لا يوجد بالرابط ماطلبته أرجو من حضرتك مساعدتي 

مازالت المشكلة قائمة أرجوا المساعدة في التوصل لحل