اذهب الي المحتوي
أوفيسنا

البحث في الموقع

Showing results for 'ترحيل شيت واحد' in content posted in منتدى الاكسيل Excel .

  • Search By Tags

    اكتب الكلمات المفتاحيه بينها علامه الفاصله
  • Search By Author

نوع المحتوي


الاقسام

  • الترحيب
  • قسم تطبيقات و لغات مايكروسوفت
    • قنوات تعليمية شخصية و دورات تدريبية مجانية و مدفوعة
    • إعلانات شخصية بأجر للاعضاء
    • المنتدى المفتوح
    • منتدى الاكسيل Excel
    • قسم الأكسيس Access
    • دعم أنظمة الويندوز المختلفة
    • منتدي الوورد Word
    • منتدى الباوربوينت
    • منتدى الاوتلوك Outlook
    • منتدى الفيزيو Visio
    • منتدي مايكروسوفت بروجكت Ms Project
    • منتدى الفرنت بيج العام Frontpage
    • تطبيقات Power Apps
    • وان نوت One Note
    • الناشر بابليشر Publisher
    • Communicator
    • Expression Web
    • SQL Server
    • VB.net
    • C#.net
    • Asp.net
  • الغات و أدوات البرمجة الأخرى
    • حوارات الويب العامة
    • Delphi
    • PHP
    • برمجة الاندرويد
  • أقسام الإدارة و إدارة المشاريع و تطبيقاتها
    • الاستراتيجية وإدارة محافظ المشاريع
    • إدارة المشاريع
    • Scaled Agile SAFe
    • إدارة الجودة
    • القيادة و تنمية المهارات
    • Primavera Enterprise
    • Primavera 3.1
  • البحث العلمي و علوم البيانات
    • مناهج البحث العلمي
    • علم الإحصاء
    • الذكاء الإصطناعي و التنقيب فى البيانات
    • Orange
    • R
    • SPSS
    • Python
  • القسم العام
    • مشاركات المدونات
    • نرحب بزوار الموقع
    • قسم الاقتراحات و الملاحظات
    • أوفيسنا على الفيسبوك

الاقسام

  • VBA Code Library
  • قسم الإكسيل
  • قسم الأكسيس
  • قسم الوورد
  • Project Management
  • Self development التطويرالذاتي
  • EFQM & DGEP
  • معلومات مفيدة
  • أدوات عامة

مدونات

  • M-Taher's Blog
  • مدونة محمد طاهر
  • Officena
  • اا الفاروق اا
  • ‎مدونة أخبار التكنولوجيا
  • M-Taher's Blog
  • يحيى حسين's Blog
  • خبور خير's Blog
  • Dr. AbdelMalek Abu Sheikh's Blog
  • m.hindawi's Blog
  • احمدزمان's Blog
  • الحسامي
  • مدونة أ / محمد صالح
  • yahiaoui's Blog
  • عبدالله المجرب's Blog
  • صيد الخواطر
  • حمادة عمر مدونة
  • مدونة جعفر
  • مدونة عادل حنقي
  • مجدى يونس: لمسة وفاء لمنتدى اوفيسنا
  • Excel Expert Financial&Accounting
  • مدونة اعمال ايقونات الماس لمنتدى اوفيسنا
  • رقائق فى دقائق
  • Shivan Rekany

ابحث عن النتائج فى ......

ابحث عن النتائج التي تحوي ....


تاريخ الانشاء

  • بدايه

    End


اخر تحديث

  • بدايه

    End


Filter by number of...

انضم

  • بدايه

    End


مجموعه


Job Title


البلد


الإهتمامات


AIM


MSN


Website URL


ICQ


Yahoo


Jabber


Skype

  1. مساء الخير الاخوه الاعزاء اساتذة الاكسيل عندى ملف فيه اتصال صرف شيك كل ايصال فى شيت منفصل وفى شيت مجمع عاوز كل بيانات الشيكات تظهر فيه زى المثال اللى انا عاملة فى ملف المرفق ويا ريت لو ممكن تبقى معدلات مش اكواد ولكن لو مقيش معدلات توفى الغرض يبقى اكواد تمام وشكرا مقدما 455.xlsx
  2. استفسار غريب معلش عندى مشكلة عند تنفيذ حماية شيت يتم عكس اتجاهات اسهم الكيبورد فيصبح اليمين يسار و اليسار يمين و لم اجد حل لذلك ارجوا المساعدة
  3. السلام عليكم تحديد اوائل القسم في امتحان نهاية العام يعتبر من اللمسات الفنية لاي شهادة وهذا الملف مفتوح المصدر . لتعم الفائدة يمكن التعديل على الملف حسب احتياجاتك اللهم اجعل هذا العمل خالصا لوجهك الكريم Awael.xlsm
  4. Sub PDF_شيت_ترم_2() Dim FSO As Object Dim S(1) As String Dim sNewFilePath As String Dim Row As Long Set FSO = CreateObject("Scripting.FileSystemObject") S(0) = ThisWorkbook.FullName If FSO.FileExists(S(0)) Then S(1) = FSO.GetExtensionName(S(0)) If S(1) <> "" Then S(1) = "." & S(1) Set WS = ActiveSheet lastRow = WS.Columns("A:A").Find(What:="*", _ SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row With WS.PageSetup .PrintArea = "$A$3:$CH$" & lastRow End With sNewFilePath = ThisWorkbook.Path & "\شيت الصف السادس ترم ثان.pdf" WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sNewFilePath, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End If Else MsgBox "لم يتم حفظ الملف ..يوجد خطأ ما " End If Sheets("شيت2").Activate Set FSO = Nothing ' mainy m = MsgBox("تم تصدير الشيت خارج الشيت بإسم شيت الصف السادس ترم ثان" & vbNewLine _ & "هذا الملف موجود فى نفس مكان برنامج الكنترول شيت", _ vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal + vbMsgBoxRight, _ "تم تصدير شيت صف السادس ترم 2 بصيغة pdf.") End Sub
  5. السلام عليكم ورحمة الله وبركاته ارجو المساعدة فى كود استدعاء من اكثر من شيت ويتغير بتغير البيانات وجزاكم الله خيرا ahmed.xlsb
  6. السلام عليكم في المرفق المعادلة تعمل للفترتين الاولى والثالثة لكن لا تعمل للفترة الثانية المطلوب تعديل المعادلة للفترة الثانية super.xlsx
  7. السلام عليكم ورحمة الله وبركاته إخواني الأعزاء هذا الملف يوجد بيه 3 شيت أول شيت "4" يتم ادخال اوقات الاضافي وحسابات الاوقات والاخصومات والتكلفة وهكذا ثاني شيت "5" مثل "4" لا يوجد فرق ثالث شيت "الاضافي" اريد ترحيل الصفوف التي بها بيانات بناء على ان وجد فى الخلية "سعات ألاضافية" عدد ساعات اي كان كم رقمها من الشيت "4" والشيت "5" مرتبين بدون صفوف فارغة بين الصفوف المرحلة بحيث اننى استخدمه مثل تقرير للطباعة وان كان ذلك يتم عن طريق المعادلات يكون افضل لمساعدتي لتعلم الاكسيل بدون vba وشكرا لكم على المساعدة test.xlsx
  8. السلام عليكم ورحمة الله وبركاته وبها نبدأ المرجوا من الإخوان الكرام مساعدتي مشكل في كود ترحيل بيانات للصفحة الثانية حسب الرقم smr.xlsm
  9. السلام عليكم عندي مجموعة من الاسماء اريد ترحيلها الى شيتات حسب الاحرف والاسماء في ازدياد جزيتم خيرا ترحيل الاسماء حسب الاحرف الى شيتات.xlsx
  10. السلام عليكم ورحمة الله وبركاته إخواتي الكرام الاعزاء برجاء التكرم والتفضل بتحويل هذا الملف الوورد الذي يحتوي على جدول انشطة الى ملف اكسل ، حيث أني حاولت اكثر من مرة ولكني كنت اواجه مشكلة كبيرة وهي انه بعد التحويل أجد الصف الموجود في جدول الوورد ينقل في الاكسل على اكثر من صف واضطر للدمج وهذا يضر البحث والفلترة فهل يمكن التكرم بتحويله الى اكسل شيت بحيث ينقل صف الوورد على صف اكسل واحد ولا يأخذ اكثر من صف.... وشكرا مرفق الجدول المراد تحويله الى اكسل انشطة جديد.docx
  11. السلام عليكم ورحمة الله وبركاته تحية طيبة لأخوانى الأعزاء بالمنتدى وجزاكم الله خيرا على تعاونكم معنا - جعله الله في ميزان حسناتكم وبعد,,, عندى 3 ملفات منفصلة :- ملف بإسم مطابقة - ملف بإسم عملاء - ملف بإسم رصيد عملاء أحتاج الى المقارنة بين ملف عملاء و رصيد عملاء ( من حيث كميات المنتجات المباعة ) حيث يحتوى كل ملف منهم على عشرات الشركات . الدالة التى اعرفها للقيام بالمقارنة هى دالة VLOOKUP وحتى استطيع استخدام دالة VLOOKUP يجب الإستعانة بملف وسيط ( مطابقة ) يظهر به بيانات ملف ( عملاء ) و ملف ( رصيد عملاء ) حتى أستطيع المقارنة بينهم. المطلوب 1- فى ملف (المطابقة) فى الخلية ( a1 ) عند اختيار اسم الشركة من القائمة المنسدلة يتم ترحيل البيانات الموجودة فى ملف ( عملاء ) بالجدول الملون ( Code المنتج يناير فبراير مارس أبريل مايو يونيو يوليو أغسطس سبتمبر أكتوبر نوفمبر ديسمبر الإجمالى ) 2- فى ملف (المطابقة) فى الخلية ( R1 ) عند اختيار اسم الشركة من القائمة المنسدلة يتم ترحيل البيانات الموجودة فى ملف ( رصيد عملاء ) بالجدول الملون ( كود المنتج - المنتج - يناير فبراير مارس أبريل مايو يونيو يوليو أغسطس سبتمبر أكتوبر نوفمبر ديسمبر الإجمالى ) 3- ان أمكن ذلك فى حالة تحديث الأرقام فى أى من ملف ( عملاء ) و ( رصيد عملاء ) يتم تحديث البيانات تلقائيا فى ملف ( المطابقة ) أعتذر عن الإطالة وكل عام وانتم بصحة وسعادة يارب إستدعاء بيانات.rar
  12. الاستاذ الفاضل محمد هشام اشكرك حضرتك على الاهتمام وسرعة الرد على الموضوع واسمح لى لتجميل العمل ان تنظر الى هذه الكلمات : 1 -ان يكون ملف الPDFكل صفحة فيه تظهر الفاتورة كاملاً من المدى ( bw330:ck372) 2 - الملف الاصلى يتعامل مع اسابيع بمعنى يتم انشاء شيت لكل اسبوع وبالتالى هناك فواتير خاصة بكل اسبوع لذا تم استحداث شيت باسم فواتير الاسبوع برجاء استكمال الكود لترحيل الفواتير بجوار بعضها كما هو موضح بالشيت 3 - تم تفسير بعض اجزاء الكود برجاء استكمال باقى الاجزاء استاذى الفاضل سلمت يداك ولكن احب اوضح 1 - الكود الاول لعمل ملف الـ PDF شكل الفواتير بالملف غير مجمع بمعنى ان الفاتورة بتكون ناقصة بتظهر نصفها والنصف الاخر فى وسط الملف .. حاولت اغير من اعدادات الورقة المسماه بـ PDF ولم تفلح التجربة .. برجاء الاطلاع عليها 2 - كود الترحيل الذى تفضلتم بعمله رائع ولكن ما اريده ان هذا الكود سيتم استخدامه اكثر من مرة بعدد اسابيع العام والمراد اظهار هذه الفواتير فى شيت واحد وضعت تصورى فى شيت باسم الشكل المطلوب ( ممكن حضرتك تضع تصور اخر يلبى ما ابغيه ، ما فيش مشكلة المهم ان فواتير السنة كلها تظهر فى شيت واحد ) هذا بخلاف شيت الPDF الخاص بالطباعة 3 - برجاء استكمال شرح كود الPDF Book222بالتعديل.xls
  13. Private Sub Workbook_Open() Dim a As Date Dim b As Date Sheet4.Range("z1").Value = Date a = Sheet4.Range("z1").Value b = "01-10-2024" Dim myvalue As String myvalue = InputBox("enterpassword") If myvalue = 123 Or a >= b Then ActiveSheet2.Unprotect Password:="55" ActiveSheet3.Unprotect Password:="55" Application.ScreenUpdating = False Application.EnableEvents = False Sheet2.Range("a1:z700").Clear Sheet2.Range("a1:z700").Interior.Color = vbBlack Sheet13.Range("a1:z700").Clear Sheet13.Range("a1:z700").Interior.Color = vbBlack Application.ScreenUpdating = True Application.EnableEvents = True ActiveSheet2.Protect Password:="55", DrawingObjects:=True, Contents:=True, Scenarios:=True ActiveSheet3.Protect Password:="55", DrawingObjects:=True, Contents:=True, Scenarios:=True MsgBox "expire" ThisWorkbook.Save Application.Quit End If End Sub علما بأن كلمة المرور 123 ورمز الحماية لورقة العمل هي 55 12 - Copy.xlsb
  14. السلام عليكم ورحمة الله وبركاته " استكمالاً للموضوع السابق " نود إضافة طلب آخر على هذا الموضوع ،،، عند ترحيل البيانات من الملف الأول إلي الملف الثاني 1) إضافة عمود يكون منسوخ من العمود الذي قبله 2) أن تكون خلايا " العمود الجديد المنسوخ " غير ملونه https://www.mediafire.com/file/td7io9bd197h88t/2024.rar/file وشكر خاص للأخ الأستاذ / @حسونة حسين لمتابعته للموضوع السابق والإجابة عن كافة الأسئلة وجزاكم الله خيرا 🌹
  15. السلام عليكم لو سمحتوا إخواني الكرام وأخص بالذكر أخي الأستاذ @حسونة حسين ,,, إذا في إمكانية عند الضغط على خلية " الرصيد H1 " وكتابة رقم "4" مثلاَ ، الكود يرحل فعلا الي صفحه الرصيد في نفس الملف اريد ان يتم ترحيل الرصيد الجديد "I1" إلي ملف اخر اسمه " 2024.xlsb " عند رقم "4 " علما أن العمود متحرك كل يوم ينضاف عمود جديد بتاريخ جديد اي ان الترحيل يكون في العامود الذي به تاريخ اليوم فقط وليس في اي عامود اخر ارسلت مرفق لتوضيح الأمر ، كلمة المرور 1122 شاكر لكم حسن تعاونكم 2024.rar
  16. السلام عليكم كل اسم يبدأ بحرف أ يتم دمجها في شيت واحد وكذلك باقي الاسماء ، فمثلا حرف (ب) كل اسم يبدأ بحرف الباء يدمج في شيت واحد تسلم ممنون
  17. السلام عليكم لو سمحتوا إخواني الكرام ,,, إذا في إمكانية عند الضغط على خلية " الرصيد H1 " وكتابة رقم "4" مثلاَ ، يتم ترحيل الرصيد الجديد "I1" إلي صفحة " الأرصدة " عند رقم "4 خلية B7" ارسلت مرفق لتوضيح الأمر ، كلمة المرور 1122 شاكر لكم حسن تعاونكم new.xlsm
  18. الاخوه الافاضل لا اعلم سبب منطقي للخطأ في الخلايا المظلله بالاصفر في العمود F &G حاولت مرارا وتكرارا لحد ما تعبت ولا اعلم لماذا هذه الخلايا دون عن باقي الخلايا مع ان كلهم ملف واحد ومسحوم من ماكينه البصمه لحضوروانصراف الموظفين test.xlsx
  19. السلام عليكم قمنا في مدرستنا بعمل شيتات جوجل لاحتياط المعلمين لكن طبعاً متابعتها واحد واحد مجهدة هل يمكن تجميعها في شيت واحد حسب التاريخ مع بقائها منفردة هذا رابط الملف https://docs.google.com/spreadsheets/d/16hGE4ZEHPqFtpgR_p6vh6IN_r-U986D_qQ8NJqM4AXw/edit?usp=sharing ارجو المساعدة
  20. عبدالله بشير عبدالله سبق أن رفعت موضوع عن ترحيل بيانات في ملف فعاليات وقد تكرم علي الأخ الفاضل الكريم عبدالله بشير عبدالله بالاستجابة السريعة ونصحني بعمل موضوع جديد لطلب شيء آخر وعلى هذا فما أوده حاليا هو ترحيل البيانات وفصلها في ملف اكسل مستقل وليس شيت جانبي لاني سأرسلها الى جهات مختلفة وكذلك ارجو إلغاء الأسطر الفارغة من الملف المنفصل الناتج عن البحث وازالة السطر العلوي المكتوب فيه "البحث من الى" من الملف المنفصل وكذلك فصله الى ملف بي دي اف لو أمكن. وجزاكم الله خير الجزاء وزادك من العلم بسطة acheivements final.xlsb
  21. السلام عليكم ورحمة الله وبركاته أساتذتي الكرام محمد هشام. @عبدالله بشير عبداللهجزاكم الله كل خير ويعجز لكلام عن شكركم هذا الملف من تعديل أستاذنا محمد هشام. جزاه الله عنا خير الجزاء أنا اسف جدا جدا عندي رجاء بسيط آخر .. هناك في الجدول في الشيت الأول SHEET1 عايز اعمل فلترة لان آخر عمود اسميته (مفتاح) يعني هاكتب فيه كلمه تدل على كل نشاط مثلا الإعاقة او الذكاء الاصطناعي او زوي الهمم وهكذا.. ، فلو عايز اعمل فلترة لكل ما يخص الإعاقة مثلا وطلع عدد من الندوات تخص هذا الموضوع عايز نتيجة الفلترة دي تتفصل برضه بنفس الطريقة الى ملفين مستقلين اكسل وبي دي اف - بمعني عايز النتيجة تشمل نتيجة الفلترة اللي هاعملها للجدول الرئيسD في SHEET1 بحيث بعد الفلتروة في SHEET1 عايز نتيجة لفلترة برضه تتفصل زي الفترة اللي بين التاريخين ومعلش الملف الاكسل او البي دي اف عايز احط ليهم عنوان فهل ينفع وجود خانة لاضافة العنوان لاني كل ما بزود سطر في الاعلى بيدي ERROR معلش انا آسف جدا جدا إنتو اخواتي في الله ربنا مايحرمني منكم يا رب ونفع بكم وزادكم بسطة في العلم وياريت معلش أخيرا عايز احط فيه كود عمل نسخة احتياطية في مكان وليكن في الD في مجلد اسمه Buckup كل فترة من الوقت .. أرجو التعديل بعد اذن حضراتكم على الملف المرفق والمعدل من قبل الأستاذ محمد هشام. زاده الله علما وجزاه الله خيرا وجزاكم الله كل خير مقدما وزادكم بسطة في العلم فلترة وحفظ الملفات V2.xlsm
  22. الأخوة الكرام السلام عليكم اعاد الله عليكم هذا الشهر الكريم بالخير واليمن و البركات عندي برنامج تحصيل اقساط مدرسية ارجو المساعدة في : 1- ترحيل بيانات كل ايصال يتم اصدارة في شيت (School Fee Receipt) الى شيت (Daily Report) بترتيب بحسب نموذج الجدول في شيت Daily Report ثم حفظ نسخة من الإيصال الصادر بصيغة PDF قبل اصدار ايصال جديد School Fee Collection System.xlsm
  23. اسف اخي على التاخير في الرد لاكنني عند الاشتغال على الملف ومراجعة الاكواد لاحظت بعد الهفوات التي لم انتبه اليها من قبل 😱 ربما انت لم تلاحظها لاكنها حتما سوف تسبب لك اخطاء بعد تحديث البيانات وخاصة عند اظافة بيانات جديدة لم تكن موجودة مسبقا على الملف ...... (رحم الله من عمل عملا فأتقنه) تفضل استبدل كود التوزيع بالكود التالي بعد تنقيحه بشكل افضل وادق Sub Create_Worksheets() '09/05/2024 by:MOHAMEED HICHAM www.officena.net "منتدى الاكسيل" ' '*********'Create Worksheets and Name Them With The First letters of The Name*********** Dim WS As Worksheet, srcWS As Worksheet Dim rgData As Range, ColName As Variant Dim Lr As Long, lColumn As Long, Irow As Long Dim rCrit As Range, destRng As Range, tmp As Range Dim dicWS As Object, dictKey As String, Cpt As Variant Dim I As Long, x As Long, nCount As Integer, lastRow As Long With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With ' نطاق المعايير Set WS = Worksheets("البيانات") With WS .Columns("J:G").Clear: .UsedRange.Hyperlinks.Delete Lr = .Cells(Rows.Count, "D").End(xlUp).Row lColumn = .Cells(1, Columns.Count).End(xlToLeft).Column + 2 Set rgData = .Range("C1:E" & Lr) ColName = rgData.Columns(2) Set rCrit = .Cells(1, lColumn) rCrit.Value = .Range("D1") Set rCrit = .Cells(1, lColumn).Resize(2) End With ' الحصول على مجموعة الحروف الفريدة - الحرف الأول من الاسم Set dicWS = CreateObject("Scripting.dictionary") dicWS.comparemode = vbTextCompare For I = 2 To UBound(ColName) ' تجاهل الفراغات If ColName(I, 1) <> "" Then dictKey = Left(ColName(I, 1), 1) If Not dicWS.Exists(dictKey) Then dicWS(dictKey) = "" End If End If Next I ' رمز اظافي للتعامل مع حرف الالف '(ا,أ,إ,آ) & Unicode & وتجميعه والذي يمكن أن يكون 4 أحرف مختلفة Dim letters As Variant, réf As Boolean, arr() As String, j As Long letters = Array(1570, 1571, 1573, 1575) ReDim arr(1 To UBound(letters) + 1) For I = 0 To UBound(letters) dictKey = ChrW(letters(I)) If dicWS.Exists(dictKey) Then réf = True dicWS.Remove dictKey End If j = j + 1 arr(j) = dictKey & "*" Next I If réf Then dictKey = Replace(Join(arr, "-"), "*", "") dicWS(dictKey) = "" End If '*مراجعة المعرفات مع إنشاء أو تحديث ورقة جديدة للمجموعة الحرفية *** For Each Cpt In dicWS.Keys ' ***التحقق من وجود ورقة العمل مسبقا*** If Evaluate("ISREF('" & Cpt & "'!A1)") Then 'تحديث Set srcWS = Worksheets(Cpt) srcWS.UsedRange.Clear Else ' اظافة Set srcWS = Worksheets.Add(after:=Sheets(Sheets.Count)) srcWS.Name = Cpt End If ' لصق البيانات Set tmp = srcWS.[A1] If Len(Cpt) > 1 Then rCrit.Cells(2).Resize(UBound(arr)) = Application.Transpose(arr) Set rCrit = rCrit.CurrentRegion Else rCrit.Offset(1).ClearContents rCrit.Cells(2) = Cpt & "*" Set rCrit = rCrit.CurrentRegion End If rgData.AdvancedFilter xlFilterCopy, rCrit, tmp rgData.EntireColumn.Copy tmp.PasteSpecial Paste:=xlPasteColumnWidths ' اظافة ارتباط تشعبي لاوراق المجوعات الحرفية Worksheets(srcWS.Name).Hyperlinks.Add Anchor:=Worksheets(srcWS.Name).[E2], Address:="", _ SubAddress:="'" & WS.Name & "'" & "!A1", TextToDisplay:="ورقةالبيانات" lastRow = srcWS.Columns("A:C").Find(What:="*", SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row '***(ازالة التكرار في حالة وجوده (على الاوراق الجديدة *** 'الاعمدة d = [{1,2,3}] srcWS.Range(srcWS.Cells(1, 1), srcWS.Cells(lastRow, 3)).RemoveDuplicates d(1), Header:=xlNo ' اعادة ترتيب التسلسل With srcWS.Range("A2:A" & srcWS.Range("B" & srcWS.Rows.Count).End(xlUp).Row) .Formula = "=IF(B2="""","""",IF(B2=""Name"",""Count"",N(A1)+1))" .Value = .Value End With Next Cpt rCrit.EntireColumn.Clear ' تحديد اوراق المجموعات الحرفية For x = 1 To Sheets.Count nf = Sheets(x).Name If Len(nf) = 1 Or (nf) Like "*-*" Then Sheets(x).Activate With ActiveSheet 'عدد الاسماء على كل ورقة lige = Evaluate("SUM(0+(A2:A" & .Cells(.Rows.Count, "A").End(xlUp).Row & "<>""""))") ' اظافة الارتباط التشعبي لجميع الاوراق الى الرئيسية WS.Hyperlinks.Add Anchor:=WS.Cells(x + 2, 10), Address:="", SubAddress:="'" & _ nf & "'" & "!A1", TextToDisplay:="حرف" & "-" & nf .Tab.Color = 5287936: [A1].Select: .DisplayRightToLeft = True: .[f1] = "عدد الاسماء": .[f2] = lige End With ' استخراج اسماء المجموعات الحرفية nams = nams & " " & "حرف" & "-" & nf nCount = nCount + 1 End If Next x ' ترتيب ابجدي لاسماء الشيتات Irow = WS.Range("j:j").Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row WS.Range("j2:j" & Irow).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp WS.Range("j1:j" & Irow).Sort Key1:=WS.[j2], _ Order1:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom WS.Activate With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic .CalculateFull End With MsgBox nams, vbInformation, "تم حفظ" & " : " & nCount & " " & "مجموعة بنجاح" End Sub اما لطلبك لحفظ الملفات بصيغة PDF تفضل اخي نظرا لعدد اوراق العمل الكثيرة على الملف التي يجب تنسيقها قبل الطباعة او الحفظ سرعة تنفيد الكود ستعتمد على امكانيات الجهاز المستخدم Sub Save_PDF() Dim wb As Workbook, _ WS As Variant, _ lastRow As Long, _ nCount As Integer, strFolder As String Const File_format As String = ".pdf" ' قم بتعديل اسم مجلد الحفظ بما يناسبك strFolder = "المجموعات الحرفية" Set wb = ActiveWorkbook: With Application .ScreenUpdating = False If MsgBox("؟" & " PDF" & " : " & " حفط الملفات ", vbYesNo) = vbNo Then Exit Sub For Each WS In wb.Worksheets If Len(WS.Name) = 1 Or (WS.Name) Like "*-*" Then Cpt = True j = "حرف" & "-" & WS.Name nCount = nCount + 1 lastRow = WS.Columns("A:C").Find(What:="*", SearchDirection:=xlPrevious, _ SearchOrder:=xlByRows).Row With wb On Error Resume Next SaveLocation = wb.Path & Application.PathSeparator & strFolder If Len(Dir(SaveLocation, vbDirectory)) = 0 Then End If MkDir SaveLocation End With ' الاعدادات With WS.PageSetup .PrintArea = "$A$1:$C$" & lastRow .PrintTitleRows = "$1:$1" .CenterHorizontally = True .CenterVertically = True .Orientation = xlLandscape .CenterFooter = j End With WS.ExportAsFixedFormat Type:=xlTypePDF, Filename:=SaveLocation & Application.PathSeparator & j & File_format, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End If Next WS .ScreenUpdating = True End With If Cpt = False Then MsgBox "لا توجد ملفات للحفظ", vbInformation, "تم إلغاء الإجراء": Exit Sub End If MsgBox "تم حفظ" & " : " & nCount & " " & "مجموعة بنجاح", _ vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal, SaveLocation End Sub ترحيل الاسماء حسب الاحرف الى شيتات V3.xlsm
  24. السلام عليكم كيف يتم ربط بيانات المعلم من شيت Data الى شيت teacher بحيث عند اختيار المعلم تتيغير بيانات التقييم teacher.xlsx
  25. اريد المساعدة في ترحيل بيانات الفاتورة علي الشكل الموجود في الشيت ترحيل.xlsx
×
×
  • اضف...

Important Information