اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

05 عضو ذهبي
  • Posts

    1,110
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    2

كل منشورات العضو ۩◊۩ أبو حنين ۩◊۩

  1. السلام عليكم الاخ الجليل طارق محمود اسال الله ان تكون بكل خير وععافيه سلمت يداك .. حل مبدع وبسيط ... جزاك الله خيرا هل يمكن اضافه اخى الحبيب هل يمكن تحد ما يتم طباعة من... الى على اساس التسلسل اى عن استخدام الكود يظهر بوكس ادخال من الى على اساس التسلسل من 1 الى 5 يتم طباعه الموظفين من واحد الى 5 اة من 1 الى 1 يتم طباعه ورقه الموظف الذى تسلسه 1 جزاك الله كل الخير والتقدير
  2. السلام عليكم الاخ الكريم محمود نفس المشكله التى تقع معى يتم ارسال الملف حتى لو تم اخيار NO دائما ما تظهر MsgBox "تم إرسال الملف الى ماليه القاهرة بنجاج ... شكرا...", 64 وهى موجوده فى اخر الكود الذى اضفته If MsgBox("هل تريد إرسال الملف المرفق إيميل أم لا؟", vbYesNo, "Send Email") = vbNo Then Exit Sub اريد عند اخيار no تظهر رسال تاكد عدم ارسال الملف والخروج من الكود
  3. السلام عليكم الاخوة الكرام ... ارجو المساعده فى اضفه للكود اريد اضافه MsgBox للكود ... قبل تنفذه هل انت متاكد من ارسال المالف ... اذا كان نعم يتم عمل الكود... اذا كان لا يتم الخروج من الكود اذا كانت الاجابه نعم يتم تنفيز الكود اذا كانمت الاجابه لا يتم الخروج من الكود لقد نفذت الطلب على اكثر من كود الا اعجز عن تنفيذه على ذلك الكود Option Explicit 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) 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 = "aaaaaaa@yahoo.com" ' .CC = "aaaaaaa@yahoo.com" '.BCC = "aaaaaaa@yahoo.com" .Subject = "aaaaaaa" .Body = "aaaaaaaaaaaaaaaaaaa" .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
  4. السلام عليكم الاخوة الكرام اريد معرفه اذا كان 'You use Excel 2000-2003 FileExtStr = ".xls": FileFormatNum = -4143 You use Excel 2007' FileExtStr = ".xlsx": FileFormatNum = 51 ما هو FileExtStr الخاص ب 'You use Excel 2010
  5. السلام عليكم الساده الكرام .. ارجو المساعده فى تعديل كود لاخ الجليل ياسر ابو البراء .. جذاه الله كل الخير والتقدير الكود يقو على ارسال نسخه بيانات وليس المعاادلان من الشيت الفعال اميل - المطلوب تغير الشيت الفعال الى اسم شيت وليكن شيت a&b اى نسخ الشيت a & b بيانات وارساله اميل واختيار ايضا اسم المصنف الجديد الذى يتم ارساله اميل ... يتم كتابته داخل الكود هلى يمكن المساعده فى ذلك Option Explicit Sub Mail_ActiveSheet_Using_Outlook() Dim fileExtStr As String Dim fileFormatNum As Long Dim sourceWb As Workbook Dim destWb As Workbook Dim tempFilePath As String Dim tempFileName As String Dim outApp As Object Dim outMail As Object With Application .ScreenUpdating = False .EnableEvents = False End With Set sourceWb = ActiveWorkbook ActiveSheet.Copy Set destWb = ActiveWorkbook With destWb If Val(Application.Version) < 12 Then fileExtStr = ".xls": fileFormatNum = -4143 Else Select Case sourceWb.FileFormat Case 51: fileExtStr = ".xlsx": fileFormatNum = 51 Case 52: If .HasVBProject Then fileExtStr = ".xlsm": fileFormatNum = 52 Else fileExtStr = ".xlsx": fileFormatNum = 51 End If Case 56: fileExtStr = ".xls": fileFormatNum = 56 Case Else: fileExtStr = ".xlsb": fileFormatNum = 50 End Select End If End With 'Change All Cells In The Worksheet To Values If You Want With destWb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False '====================================== 'Save The New Workbook/Mail It/Delete It tempFilePath = Environ$("temp") & "\" tempFileName = Replace(sourceWb.Name, ".xlsm", "") Set outApp = CreateObject("Outlook.Application") Set outMail = outApp.CreateItem(0) With destWb .SaveAs tempFilePath & tempFileName & fileExtStr, FileFormat:=fileFormatNum On Error Resume Next With outMail .To = "aaa@.com" 'Change Email .CC = "aaa@.com" .BCC = "aaa@.com" .Subject = "بدلات " .Body = " مع تحيات ..إدارة الشئون الادارية )- 8240" .Attachments.Add destWb.FullName .Send End With On Error GoTo 0 .Close savechanges:=False End With 'Delete The File You Have Sent Kill tempFilePath & tempFileName & fileExtStr Set outMail = Nothing Set outApp = Nothing With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
  6. السلام عليكم اخى الحبيب ياسر لم اجد فى اصل الكود ماذا تقصد بها ملحوظه الملف الذى اريد جلب البيانت فيه هو Zayed Allaw Cairo.xlsb فى شيت Zayed Allaw Const strInput =
  7. السلام عليكم اخى الحبيب ..... ياسر ابو البراء عمل رائع رائع ... والكود يعمل بشكل ممتاز.. وهذا مابحث عنه ... ولاكن وجدته بعد الانتهاء من موضوع ( تصحيح خطاء فى كود ) الذى وضعت الحل المناسب له ... ولاكن إثراء للموضوع حاولت تطبيق كود Get Data From Closed Workbook على المرفق الا ان النتائح تاتى بشكل غريب ( #REF! ) ارجو توضيح السسبب وإصلاحه الخطاء الملف الذى اريد جلب البيانات منه وهو مغلق هو TIME SHEET TAREK EK 2017.xlsb من الشيت Zayed Allaw .. والنطاف من X18 : A1 والملف الذى اريد جلب البيانت فيه هو Zayed Allaw Cairo.xlsb فى شيت Zayed Allaw .. والنطاف من X18 : A1 Get Data From Closed Workbook.rar
  8. اخى الحبيب ....ياسر ابو البراء دائما موجود ... حيث نحتاج وجودك جزاك الله كل الخير .... كود رائع رائع
  9. السلام عليكم الاخ العزيز ياسر .... جزاك الله خيرا على وقتك تقبل شكرى ووافر تحياتى السلام عليكم الاخ العزيز ياسر .... جزاك الله خيرا على وقتك تقبل شكرى ووافر تحياتى
  10. السلام عليكم الاخ العزيز ياسر .... جزاك الله حيرا على وقتك فعلا دائما ما اقع فى نفس الخطاء ... ععدم توضيح الامر بشكل وافر تقبل عزرى اخى الحبيب ياسر 1- الملف المراد نقل البيانات منه TIME SHEET TAREK EK 2017 من الشيت Zayed Allaw النطاق من X19 : A1 2- الملف المراد نقل البيانات اليه Zayed Allaw Cairo فى الشيت Zayed Allaw الى النطاق من X19 : A1 والملفين موجودن فى فولد واحد فى جزاك الله كل الخير .. New folder (2).rar
  11. السلام عليكم الاخوة الكرام والساده الافاضل ارجو المساعده فى الاتى :- تم عمل كود يقوم بنسخ محدتوى محدد ولصقه فىشيت بداخل ملف اخر ( TIME SHET ZAYED ) والكود يعمل بشكل ممتاز المطلوب ان يعمل الكود حتى وان لم يكن الملفالمراد نقل البيانات اليه مفتوح ( TIME SHET ZAYED) هل يمكن المساعده فى تحقيق ذلك الامر جزاكم الله كل الخير Sub zayed_allaw() Application.ScreenUpdating = False Range("A1:X19").Select Selection.Copy ActiveWindow.SmallScroll Down:=-12 Windows("TIME SHET ZAYED.xlsx").Activate ActiveWindow.SmallScroll Down:=-18 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Range("A1").Select Windows("TIME SHEET TAREK EK 2017.xlsb").Activate Application.CutCopyMode = False Range("A1").Select Application.ScreenUpdating = True End Sub
  12. السلام عليكم الاخوة الكرام والساده الافاضل ارجو المساعده فى الاتى :- المطلوب يوجد ملف به اكثر من شيت..... والمطلوب عمل كود يقوم بارسال شيت محدد ( zayed) عن طريق الاميل .. إميل الاوتلوك على ان يكون الملف الذى يتم ارسال بيانات فقط وليس معادلات او ارتباطات ( قيمة فقط ) هلى يمكن ذلك Book1.rar
  13. السلام عليكم الساده الكرام ارجو المساعده اريد ارسال شيت محدد ZAYED من ملف عن طريق الاميل بإمتداد xlsx او عمل ملف جديد لالبيانات المووده فى شيت محدد وارساله اميل ( البيانات فقط ) Book1.rar
  14. السلام عليكم االاخالكريم يوسف جرب المعادله بهذا الشكل =VLOOKUP(D3;P3:S3;2;0)
  15. السلام عليكم االاخالكريم يوسف جرب المعادله بهذا الشكل =VLOOKUP(D3;P3:S3;2;0)
  16. السلام عليكم اخى الفاضل الشهابى اخى الكريم محمود - الشريف جزاكم الله كل الخير ... دائما ما اجد اكثر من حل للموضع .. ودائما ما تضيفوا الى الحل حلول سلمت يداكم بكل حير
  17. السلام عليكم اخى الحبييب بن علية حاجى جزاك الله كل الخير والتقدير سلمت يداك .. حل مبدع ولى سوال كيف يمكن اصافه شيت اخر مثل شيت Suez وشيت Clep لانهم اكثر من شيت جزاك الله كل الخير
  18. السلام عليكم الاخوة الكرام ارجو المساعده فى المعادله ( VLOOKUP) يوجد فى شيت CAIRO وشيت ALX. ارقام الموظفين واسماء التدريبات المرشحين لها ويوجد تواريخ هذه التدريبات ونلاحظ ان تدريب AA له 3 مواعيد لان كل موظف له ميعاد محدد المطلوب فى شيت EXP عند اختيار مكان التدريب N1 ورقم الموظف N2 واسم التدريب H19 يتم جلب التاريخ الصحيح لتدريب الموظف والمرتبط باسم التدريب ومكان التدريب فى الخليه K8 تدريب.rar
  19. السلام عليكم اخى الكريم اى شيت تريد حمايته بعد الترحيل ؟؟؟؟؟
  20. السلام عليكم الاخ الكريم طارق محمود ... مفتقدينك بحلولك المميزة وارجو ان تكون بكل خير وعافيه
  21. الاخ الكريم الكود هيكون بهذاالشكل Sub TARHEEELL() Dim FS As Worksheet, TS As Worksheet Dim R, ER1, ER2 Set TS = Sheets("data") Set FS = ActiveSheet ER2 = TS.Range("A55555").End(xlUp).Row + 1 Application.ScreenUpdating = False Sheets("data").Unprotect Password:="aaa" If FS.Name <> "data" Then For ER1 = 3 To FS.Cells(Rows.Count, 1).End(xlUp).Row If FS.Cells(ER1, 1) <> "" And FS.Cells(ER1, 14) <> "مرحل" Then TS.Cells(ER2, 1).Resize(1, 13).Value = FS.Cells(ER1, 1).Resize(1, 13).Value FS.Cells(ER1, 14) = "مرحل" ER2 = ER2 + 1 End If Next ER1 End If Application.ScreenUpdating = True Sheets("data").protect Password:="aaa" End Sub
  22. الاخ الكريم عند كتابه الجواب ... وجت رد الاستاذ الفاضل ياسر خليل وهو خير معلم جزاه الله كل الخير
×
×
  • اضف...

Important Information