۩◊۩ أبو حنين ۩◊۩

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

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

السلام عليكم ارجو المساعده فى عمل كود ترحيل وإنشاء شيت حسب اسم اليئر من الخلايا A63 :A81 اذا لم يكن موجود وعندانشاء شيت لم يكن موجود يتم اضفه راس الصفحه للشيت الجديد من A62 : O62 ثم ترحيل قيم البئر مثال الشيت Data_base البئر RKNS-13 (A63) اذا تواجد شيت باسم هذا البئر يتم ترحيل القيم من الخليه A63 : O63 وعند كل ترحيا يتم ترحيل القيم من الخليه A63 : O63 واذا لم يتواجد شيت باسم البئر RKNS-13 يتم انشاء شيت جدير باسم البئر واضافه راس للصفحه الجديده من A62 : O62 ثم اضافه القيم الموجده امام البئر وكهذا وهذا الامر يطبق على اسماء الابار ابتداء من الخليه A63 : A80 ارجو ان يكون المطلوب واضح Book1.rar

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

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

السلام عليكم الاخ الكريم ابو علي و سدرة جزاك الله كل على وقتك ومجهودك اخى الحبيب استخدام كود وذلك لان القيم المتغيره هى المراد ترحلها والمعادلات تجعل اى اسم غير موجد امامه قيمه صفر وتم حبل الامر بكود من ابداع الاخ حسام ..جزاه الله كل الخير والتقدير مرفق الكود لاستفاده لمن اراد Sub alsqr() For i = 30 To 40 For r = 2 To 20 If Cells(i, 2) = Cells(r, 2) Then Cells(r, 6) = Cells(i, 4) End If Next Next End Sub

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

السلام عليكم الاخوه الكرام ارجو المساعده فى عمل كود يقوم بنقل قيمه الورديه من( D30To D40 )حسب الاسم المقابل لها فى الخلايا من (B30 TO B40 ) الاسم احمد 1 قيمه الورديه الخاصه به 15 الاسم احمد 3 قيمه الورديه الخاصه به 20 وهكذا يتم نقل القيمه الىى العمود F ابتداء من الخلايا ( F2 To F20 ) كما بالشكل بنفس الفرمات Sheft.rar

السلام عليكم اخى الحبيب سليم جزاك الله خير تم حل الموضوع ووضع الشرط كما ذكرت وارجو منك توضيح الشرك وخاصه 3> If Application.CountIf(ActiveSheet.Range("b1:b3"), Sheets("help").Range("a1")) < 3 Then Kill_Myself

السلام عليكم اخى الحبيب سليم جزاك الله خير اخى ابحبيب فعلا وضعت الشرط الا انلا اجد مشكله ارجو النظر فى المرفق وارجو ان نصل لحل للوتضيح المفوروض عند فتح الملف اذا كام محتوى الخليه a1 لا يساوى b1 او لا يساوى b2 او لا يساوى b3 ينم حزف الملف المفترض ان الخليه b1 الى b3 هما اسماء المستخدمين او اسماء الاجهزة التى مصرح بها استخدام الملف وان الخليه a1 هو اسم المستخدم الحالى او اسم الكمبيوتر الحالى Book12.rar

السلام عليكم الاخوه الكرام ارجو المساعده لوضع شرط فى حدث الملف عن فتحه لتنفيذ كود اخر الشرط اذا كان قيمة محتوى الخلية A1 فى شيت help لا تساوى محتوى الخليا من B1 الى B3 يتم استدعاء كود Kill_Myself لانى لم اوفق فى وضع الشرط بشكل صحيح

السلام عليكم الاخ الفاضل تم فك الحمايه عن الملف __MWO files .rar

السلام عليكم عن ملف اكسيل تتحدث ؟؟؟؟

up

up

up

السلام عليكم الاخوه الكرام ارجو التعديل على الكود المرفق والذى يقوم بإرسال نطاق محدد عن طريث الاميل من A1 : AK50 من شيت ZAYED المطلوب اضافه نطاق جديد وهو (A1 : AK50) من شيت اسمه CHIKE ZAYED الى النطاق السابق او اضافه الشيت المسمي CHIKE ZAYED الى النطاق A1 : AK50 من شيت ZAYED ارجو ان يكون المطلوب واضح جزاكم الله خيرا Sub Mail_Range() 'Working in Excel 2000-2016 'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm Dim Source As Range Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim OutApp As Object Dim OutMail As Object Set Source = Nothing On Error Resume Next Set Source = Range("A31:Al53").SpecialCells(xlCellTypeVisible) If MsgBox("هل تريد إرسال بدلات المقاول ذايد عطية الى مالية القاهرة ???؟", vbYesNo, "Confirm To Send Email To Cairo") = vbNo Then Exit Sub On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = Environ$("temp") & "\" TempFileName = "Tarek Zayed Allow" & Format(Date, "mm-yy") If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2016 FileExtStr = ".xlsx": FileFormatNum = 51 End If Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Dest .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .To = "a@khalda-eg.com;shehab.mohamed@khalda-eg.com;attia.kamel@khalda-eg.com" .CC = "b@khalda-eg.com;attia.kamel@khalda-eg.com" .BCC = "c@khalda-eg.com;mohamed.helal@khalda-eg.com" .Subject = "بدلات عمالة المقاول زايد عطيه - حقول طارق" .Body = "مع تحيات الشئون الاداريه " .Attachments.Add Dest.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display End With On Error GoTo 0 .Close savechanges:=False End With Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With MsgBox "تم إرسال الملف الى ماليه القاهرة بنجاج ... شكرا...", 64 End Sub السلام عليكم الاخوة الكرام هل الحل ان يكون النطاق بهذاالشكل Set Source = Range("A31:Al53").SpecialCells(xlCellTypeVisible) Set Source = Range(Sheets(Array("CHIKE ZAYED")).SpecialCells(xlCellTypeVisible))

اخى الكريم التعريف الى موجود Dim lngNum As Long هلى احوله الى Dim lngNum As Variant

السلالم عليكم عند تنفيذ كود ترحيل يتم بشكل ممتاز اذا كانت فى الخليه ارقام فقط واذا احتوت الخليه على حروف تظعر رساله الخطاء بهذا الشكل ملونه بالاصفر lngNum = wshS.Cells(lngRow, 2).Value لماذا

السلام عليكم نقسم الموضوع ونرجع نجمعه مره اخرى 1 يوجد ملف اسمهه Manafist Tarek 2017 وهو معنى بنظام الاجازات به 4 شيتات طائرة وصحراوي وزراعى ومطروح نجعل الامر على شيت طائرة وبعد كده نعمم الموضوع على باقى الشيتات الاربعنبداء ... يوجد فى شيت طائرة موظف رقه 1773 الموظف يقوم بأجازه من يوم 1/1/2017 وتاريخ عودته 6/1/2017 هى ديه المعطيات يوجد ملف اخر اسمه TIME SHEET TAREK 2017 به شيت اسمه Inbut data وهذا الملف يحتوى على ارقام الموظفين واسمائهم ومقسم 12 شهر وكل شهر به عدد الايام الخاصه به من 1 الى 30 مثلاهذا الملف معنى بحركه الموظفين وبه رمز E ومعناه اجازةالمطلوب عايز كود يقوم بترحيل حركه الاجازه من ملف Manafist Tarek 2017 من شيت طائرة وصحراوى وزراعى ومطروح على اساس تاريخ المغادره الى تاريخ العوده الى هى من يوم 1/1/2017 وتاريخ عودته 6/1/2017ويترجمها الى E ابتداء من ثاني يوم المغادره من يوم 2/1/2017 اى انه هيقوم بالبحث عن رقم الموظف 1773 فى ملف TIME SHEET TAREK 2017 فى شيت Inbut data ويقوم بوضع رمز E امام كل يوم اجازه عدا اوي يوم اجازه يتركه بدون رمزيعنى بالشكل ده 8 7 6 5 4 3 2 1 E E E E E اتمنى ان الصوره تكون وضحت ويتم تطبيق ذلك على الاربع شيتات مع العلم ان كل شيت به اكثر من موظف قد يصل الى عشره موظفين حمايه الشيتات 219161221 Desktop2.rar

السلام عليكم الاخوة الكرام ارجو المساعده فى اظهر اوامر الشيت حيث قمت من قبل بأخفاء خصائص اوامر الشيت ولا اتذكر كيفيه ارجاعها مثل ااوامر INSERT &Delete &Rename كما بالصوره ارجو توضيح الامر جزاكم الله كل الخير والتقدير http://www.flflh.com/download-87083-1.jpg.html

السلام عليكم الاخ الحبي والعزيز بن عليه حاجى جزاك الله كل الخير ... دائما موجود لكل حل .... سلمت يداك وارجو من الله ان تكون بكل صحه وعافيه

السلام عليكم الساده الكرام ارجو المساعده فى الاتى استخلاص اعلى 5 قيم بلاسماء الخاصه بهم فى النطاق F2 الى G20 فى الخلايا B2 الى C6 مع العلم قد تتواجد قيمه مكررة كما فى F8 & F10 فيتم احتسابها من الخمس قيم لينك الملف http://www.flflh.com/download-87073-اعلى لم استطيع رفع الملف من خلال الموقع

السلام عليكم الاخ الجليل ياسر خليل نعم المقصود ان يتم التعامل من الشهر السابق أياً كان الشهر وتم الامر شكل ممتاز جزاك الله كل الخير والتقدير

السلام عليكم الاخوة الكرام ارجو المساعده فى تعديل على سطر فى كود MyName = "D:\بدلات المقاولين\بدلات الخفراء والعمالة الغير فنية_" & Format(Date, "mm-yyyy") & ".pdf" والخاص بتسميه الملف بعد حفظه pdf بدلات الخفراء والعمالة الغير فنية - الشهر - السنه مثال ( بدلات الخفراء والعمالة الغير فنية_07-2017.pdf ) المطلوب اذا كان التايخ الحالى شهر 7 ......يتم طرح شهر من التاريخ اى ( بدلات الخفراء والعمالة الغير فنية_06-2017.pdf ) Sub PDF_ALL() Application.ScreenUpdating = False On Error Resume Next ActiveSheet.Unprotect "219161221" MyName = "D:\بدلات المقاولين\بدلات الخفراء والعمالة الغير فنية_" & Format(Date, "mm-yyyy") & ".pdf" Range("C45").Select Sheets(Array("بدل")).Select Sheets("رمضان 1").Activate MyMsg = MsgBox("هل انت متاكد من اتمام عمليه الحفظ", 4, "تنبيه") If MyMsg = 6 Then ChDir "D:" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:= _ MyName, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ True MsgBox "تم الحفظ" Else MsgBox "لم يتم الحفظ" End If Application.ScreenUpdating = True Sheets("رمضان 1").Select ActiveSheet.Protect "219161221" End Sub ارجو يكون المطلوب اتضح