ابو فارس2013

السلام عليكم اخي عمرو الملف يعمل دون مشاكل كل ما عليك تعبئة الخانات التي باللون الاحمر واحفظ الملف واغلاقه ومن ثم فتحه وسوف يقوم بارسال ايميل للتواريخ المنتهية. حاول واخبرني بالنتيجة الملف في المرفقات ehab new.rar

الحمدلله على هذه النعمة وهي حب الجميع للمهندس احمد ان شاء الله احاول التواصل معه وطمأنتكم عنه

مشكور جدا على هذا الشرح الوافي ولكن يجب ان نذكر انفسنا بالحديث النبوي الشريف : >>>>الربا اثنان وستون بابا أدناها مثل إتيان الرجل أمه<<<<< اللهم اغنينا بحلالك عن حرامك

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

هذا هو ملف الايميل للاوتلوك الذي اضفت عليه الكود ولم ينجح تقسيم الرسالة contract v-1.rar contract v-1.rar

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

السلام عليكم ورحمة الله وبركاته ارجوا من ادارة الموقع المحترمة ان تعطيني سبب اغلاق هذا الموضوع http://www.officena.net/ib/index.php?showtopic=59525&hl= وشكرا

بارك الله فيك استاذ عبدالله مشكور & vbNewLine & ساحفظها ان شاء الله

بسم الله الرحمن الرحيم احبتي في الله يوجد ملف في المرفقات يقوم بارسال رسالة عند انتهاء المدة المحددة المطلوب كود او طريقة لجعل الرسالة مؤلفة من اكثر من سطر ارجوا الافادة مع العلم ان الرسالة الان تصل بالشكل التالي: RENT EXPIRED FOR MR 1 ON DATE 16/03/2015 AFTER 10 DAYS AMOUNT IS 60000 ولكن اريدها ان تصبح مثلا هكذا RENT EXPIRED FOR MR 1 ON DATE 16/03/2015 AFTER 10 DAYS AMOUNT IS 60000 email from any server.rar

عجبالا يوجد اي مكتابات References تضاف هذا هو الكود الخاص بالمثال الاول Option Explicit Dim a() Dim b, c, d, e Dim ws As Worksheet Private Sub Worksheet_SelectionChange(ByVal Target As Range) Set ws = Sheets("data") If Not Intersect([A2:A17], Target) Is Nothing And Target.Count = 1 Then e = ws.Cells(Rows.Count, 1).End(xlUp).Row a = ws.Range("A2:A" & e).Value With Me.ComboBox1 .List = a .Height = Target.Height + 3 .Width = Target.Width .Top = Target.Top .Left = Target.Left .Visible = True .Activate .ListRows = 20 .MatchEntry = fmMatchEntryNone .TextAlign = fmTextAlignRight End With Me.ComboBox1 = Target Else Me.ComboBox1.Visible = False End If If Not Intersect([H2:H17], Target) Is Nothing And Target.Count = 1 Then UserForm1.Left = Target.Left + 150 UserForm1.Top = Target.Top + 70 - Cells(ActiveWindow.ScrollRow, 1).Top UserForm1.Show End If End Sub Private Sub ComboBox1_Change() If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then Set b = CreateObject("Scripting.Dictionary") d = UCase(Me.ComboBox1) & "*" For Each c In a If UCase(c) Like d Then b(c) = "" Next c Me.ComboBox1.List = b.keys Me.ComboBox1.DropDown End If ActiveCell.Value = Me.ComboBox1 End Sub Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean) e = ws.Cells(Rows.Count, 1).End(xlUp).Row Me.ComboBox1.List = ws.Range("A2:A" & e).Value Me.ComboBox1.Activate Me.ComboBox1.DropDown End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell.Offset(1).Select End Sub وهذا خاص بالمثال الثاتي اي اليوزرفورم Option Explicit Dim a() Dim b, c, d, e Private Sub Label1_Click() ActiveCell = Me.ComboBox1 Unload Me End Sub Private Sub UserForm_Initialize() Me.Caption = "http://www.officena.net" Dim ws As Worksheet: Set ws = Sheets("data") e = ws.Cells(Rows.Count, 1).End(xlUp).Row a = ws.Range("A2:A" & e).Value With Me.ComboBox1 .List = a .ListRows = 20 .MatchEntry = fmMatchEntryNone .TextAlign = fmTextAlignRight End With End Sub Private Sub ComboBox1_Change() Set b = CreateObject("Scripting.Dictionary") d = UCase(Me.ComboBox1) & "*" For Each c In a If UCase(c) Like d Then b(c) = "" Next c Me.ComboBox1.List = b.keys Me.ComboBox1.DropDown End Sub Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer) If KeyCode = 13 Then ActiveCell = Me.ComboBox1: Unload Me End Sub السلام عليكم مشكورين جميعا لماا تقدموه جعله الله في ميزان حسناتكم ان شاء الله اريد منكم ان تشرحوا لي الكود اذا امكن او اقل شي تشرحوا لي اين الجزء الخاص بجلب البيانات من شيت الداتا واعتذر على هذه الاسئلة التي تعتبر بديهية لكم ولكن لقلة خبرتي بالاكواد وشكرا

http://www.officena.net/ib/index.php?showtopic=59364&hl= الظاهر ان كاتب الموضوع طلبه مرتين

عمل رائع استاذ ياسر

هذه نقطة من بحر علمكم استاذي الفاضل ابن مصر شكرا للتشجيع

بالظبط الان وجدتها في ملف المهندس ابن مصر Private Sub Workbook_Open() btnSendEmail End Sub شكرا لك اخي على المساعدة :fff:

بسم الله الرحمن الرحيم الشكر للجميع وخصوصا لمبرمجين هذا الصرح العظيم الذين تعلمنا منهم الكثر الكثير احاول ان اتعلم من حضراتكم فقمت ببعض التعديلات على الملف الاساسي للاستاذ ايهاب الذي برمجه المهندس العزيز ابن مصر فقمت بتحويله للغة الانكليزية بما يناسب طبيعة عملي واضفت عليه بعض التعديلات : 1- اخذ بيانات الايميل للمستلم والمرسل والباسوورد من الصفحة الخارجية دون الحاجة للدخول للكود وتعديل الايميل 2- اضفت مربع لبيانات السرفرات لجميع الايميلات تقريبا لتساعد اي شخص باستخدامه اتمنى ان تعجبكم ehab new.rar