ياسر خليل أبو البراء

تفضل أخي الغالي Change Print Area.rar

مشكور أخي أحمد على اهتمامك بالرد وتأكد أن الجميع هنا لا يبخلون أبدا بعلمهم أو بوقتهم من أجل مساعدة كل الأخوة .. كل ما في الأمر إما أن يكون الأخوة الكرام مشغولين أو أن الموضوع مبهم بالنسبة إليهم أو خلافه ..فالتمس لنا العذر وحاول أن تصبر دائما فالصبر مفتاح الفرج (بس فرج مش موجود النهاردة عنده شغل في إسكندرية) تقبل تحياتي

أخي الكريم جرب الكود التالي : Sub ChangePrintArea() If Range("A1").Value = "OFF_" Then ActiveSheet.PageSetup.PrintArea = "A3:M15" ElseIf Range("A1").Value = "ON_" Then ActiveSheet.PageSetup.PrintArea = "B3:N15" Else ActiveSheet.PageSetup.PrintArea = "" End If End Sub يوجد ملف مرفق Change Print Area.rar

الحمد لله أن تم الموضوع على خير .. ونصيحة مني لو طرحت موضوع خليك في نفس الموضوع ولا تطرح موضوعات أخرى بنفس المضمون بل قم فقط في كل مرة بتوضيح المطلوب بشكل مختلف وإن شاء الله تجد المساعدة وسر بيني وبينك كنت متضايق من طرحك للمشكلة في أكثر من موضوع (هذا لا يجدي نفعا طالما أن الفكرة لم تصل للأخوة الأعضاء ..) الجميع هاهنا يقدم المساعدة كل على قدر استطاعته ولا يكلف الله نفساً إلا وسعها .. ودائما أنا أكرر أن يكون المطلوب وااااااااااااااااضحاً وأشعر أن العضو صاحب المسألة متضايق من مثل هذا الرد بأن يستوجب التوضيح لأن وضوح الطلب عليه عامل في المساهمة في الحل بشكل سريع ودقيق نقطة أخرى : يا ريت لو مفيهاش تعب بالنسبة لك .. الموضوعات التي قمت بطرحها بشأن هذا الملف أن تضيف رد فيها تطلب من المشرفين إغلاقها حتى لا تكثر الموضوعات المتعقلة بنفس الطلب تقبل تحياتي

جرب هذا التعديل البسيط Sub btnSendEmail() On Error GoTo 1 Dim Mail As New Message Dim Config As Configuration: Set Config = Mail.Configuration Dim LR As Long Dim i As Integer Dim ws As Worksheet Set ws = ThisWorkbook.Sheets("الايجارات") Application.ScreenUpdating = False With ws .Visible = xlSheetVisible LR = .Range("A" & Rows.Count).End(xlUp).Row For i = 4 To LR If Trim(.Cells(i, 4).Value) = "مطلوب" And .Cells(i, 8).Value = "" Then Config(cdoSendUsingMethod) = cdoSendUsingPort Config(cdoSMTPServer) = "smtp.mail.yahoo.com" Config(cdoSMTPServerPort) = 465 Config(cdoSMTPAuthenticate) = cdoBasic Config(cdoSMTPUseSSL) = True 'Change To Your Real yahoo Mail Config(cdoSendUserName) = "ehabmamdouh28@yahoo.com" 'Change To Your Real Password Config(cdoSendPassword) = "ehab" Config.Fields.Update Mail.To = "ehabmamdouh28@yahoo.com" Mail.from = Config(cdoSendUserName) Mail.BodyPart.Charset = "UTF-8" Mail.Subject = "اشعار" Select Case .Cells(i, 2).Value Case "اقامه" Mail.TextBody = "انتهاء اقامة السيد" & " " & .Cells(i, 1).Value & " " & "بتاريخ" & " " & .Cells(i, 6).Value & " " & "متبقي عليها" & " " & .Cells(i, 7).Value Case "ايجار" Mail.TextBody = "انتهاء ايجار المحل" & " " & .Cells(i, 1).Value & " " & "بتاريخ" & " " & .Cells(i, 6).Value & " " & "متبقي عليه" & " " & .Cells(i, 7).Value & " " & "والمطلوب" & " " & .Cells(i, 3).Value Case "سجلات" Mail.TextBody = "انتهاء السجل للمحل" & " " & .Cells(i, 1).Value & " " & "بتاريخ" & " " & .Cells(i, 6).Value & " " & "متبقي عليه" & " " & .Cells(i, 7).Value End Select Mail.Send ' MsgBox "تم ارسال البريد بنجاح" .Cells(i, 8).Value = "تم التنبيه وارسال البريد" End If Next .Visible = xlSheetHidden End With Application.ScreenUpdating = True 1 End Sub

بعد إذن أخي الحبيب الغالي محمد الريفي جرب هذا الملف ..النتائج مختلفة .. Convert Number To Days & Months & Years.rar

أخي الكريم جرب الملف التالي اخفاء صف.rar

الحمد لله أخي الحبيب أن تم المطلوب وأشكرك جزيل الشكر على شرحك الوافي للموضوع ..ودا اللي نفسه الأخوة الكرام يعملوه لما يطرحوا موضوعات جديدة إنهم يشرحوا بالتفصيل الممل طلبهم لأن دا بيساعد بنسبة كبيرة في الحل .. معرفة المطلوب أقصر الطرق للوصول لأفضل الحلول في أقل الأوقات وبأقل مجهود ... توضيح المطلوب >>>>> حل أفضل + توفير للوقت + توفير للجهد + سهولة البحث للباحث فيما بعد + راحة نفسية (ومزايا أخرى كتير)

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

الحمد لله الذي بنعمته تتم الصالحات الحمد لله أن تم المطلوب أخي الساهر(بس حاول متسهرش كتير ونام بدري ..على رأي الشاعر اللي معرفش اسمه : من نام بدري وصحا بدري ، صار طبيبا ولا يدري) متنساش تحدد الإجابة اللي عجبتك كأفضل إجابة .. تقبل تحياتي

ارفق ملفك أفضل

أخي الفاضل ... الرقم 1 في السطر الأول يعني أنه إذا كان التعامل مع أكثر من خلية واحدة لا يتم تنفيذ الكود .. فهذا السطر احرازي لتجنب ظهور رسالة خطأ السطر الثاني يعني أن التعامل سيكون بداية من الصف اللي بعد الثاني أي بداية من الصف الثالث (أي أن التعامل مع الخلايا ملغي في الصف الأول والثاني) السطر الثالث خاص بالتعامل مع العمود وسيكون التعامل من خلال هذا السطر مع العمود الثاني فقط .. أرجو أن أكون قد أفدتك ..عموما جرب وحاول وإن شاء الله تحقق المطلوب

أخي بالله عليك ..دلوقتي دي معادلة .. ايه المطلوب إن شاء الله ..المعادلة أدت الغرض أم لا ؟ وإذا كانت تؤدي الغرض فما هي المشكلة الآن ......... وضح بشيء من التفصيل ما يدور بخلدك إذا كنت تقصد عملها بالكود تفضل جرب هذا الكود البسيط Sub SumCells() Range("I53").Formula = "=+I51+I50-I52" End Sub

جرب هذا الملف ActiveX Control Warning Message.rar

الأفضل لو أرفقت الملف نفسه عموما أعتقد أنها رسالة أمان ليس أكثر ولا أقل ... عموما جرب تدخل على Excel Options ثم Trust Center ومن الجهة اليسرى اختر ActiveX Settings واختر آخر اختيار Enable all controls without restrictions وأزل علامة الصح من الخيار اللي تحتيها

جرب الكود بهذا الشكل Private Sub CommandButton1_Click() Columns("L:L").ClearContents Range("I12:I" & Cells(Rows.Count, "I").End(xlUp).Row - 15).Copy Range("L27").PasteSpecial xlPasteValues Application.CutCopyMode = False End Sub

أين الرسالة؟ أكيد ضاعت في البوستة .. يرجى رفع صورة الرسالة مرة أخرى أو كتابة مضمون الرسالة ؟؟

أخي الفاضل أحمد جرب الملف التالي وشوف النتائج وإن شاء الله تقدر تعدل عليه بما يتناسب مع عملك Move Data Using Worksheet_Change.rar

سؤال هل تريد عمل دالة معرفة UDF Function أم تريد معادلة ؟؟ ولو فيها غلاسة ممكن توضح شكل النتائج المطلوبة ؟؟ صراحة اطلعت على الملف ولم أفهم طلبك فهم الطلب يساهم في حل المشكلة بنسبة 90% فيرجى التوضيح

جرب الملف التالي Book1.rar

ممكن شوية توضيح إذا سمحت يا مستر زكريا

جرب الكود بهذا الشكل قمت عن الاستغناء عن النطاق المسمى chose والاستدلال عليه بالأكواد K7:K وآخر صف به بيانات Sub حسب_الاختيار() 'الغاء خاصية اهتزاز الشاشة Application.ScreenUpdating = False 'تعريف المتغير Dim c As Range For Each c In Sheet1.Range("K7:K" & Cells(Rows.Count, 2).End(xlUp).Row) 'تساوي كلمة نعم[chose]إذا كانت الخلية داخل النطاق المسمى If c.Value = "نعم" Then 'متغير يحمل قيمة آخر صف به بيانات في ورقة النتائج بالعمود الثاني مضافاً إليها رقم 1 استعداداً لبيان جديد lstrow = Sheet2.Range("b20000").End(xlUp).Row + 1 'يساوي نفس النطاق في ورقة الأساسيين[I]إلى العمود[B]النطاق في ورقة النتائج من العمود Sheet2.Range(Sheet2.Cells(lstrow, "B"), Sheet2.Cells(lstrow, "I")) = _ Sheet1.Range(Sheet1.Cells(c.Row, "B"), Sheet1.Cells(c.Row, "I")).Value 'مسح بيانات الصفوف التي تم ترحيلها Sheet1.Range(Sheet1.Cells(c.Row, "B"), Sheet1.Cells(c.Row, "K")).ClearContents 'تحديد ورقة الأساسيين Sheets("الأساسيين").Select '[B7]تحديد الخلية Range("b7").Select End If Next c 'رسالة تفيد بانتهاء عملية الترحيل MsgBox ("تم ترحيل الصفوف المحددة بنجاح"), vbDefaultButton1, " تحياتي أ / محـمـود جـمـعـه " 'تفعيل خاصية اهتزاز الشاشة Application.ScreenUpdating = True End Sub

أخي جرب الملف التالي قد تكون فكرته بعيدة بعض الشيء عن طلبك ولكنها قد تؤدي الغرض مش هتخسر حاجة لما تجرب Move Data.rar

أخي الحبيب طارق جزيت خيرا على طلب النصيحة بصراحة ابن مصر وفى بالنصيحة .. الفكرة تكمن في التطبيق العملي والاستمرار .. وإذا تعلمت شيئاً جديداً قم بإفادة إخوانك فهذا أثبت للمعلومة ، وقد يضيف لك الأخوة معلومة جديدة أثناء تقديمك للمعلومة التي تعلمتها .. بمعنى آخر فيد ستسفيد !!!!!!!!!! ولا تنسى أن تفتح الباب (بس بالله عليك ابقى اقفله وراك عشان الجو برد والناس جوا بتكتك من البرد) في انتظار متابعتك لحلقات افتح الباب يا أخ إيهاب وإن شاء الله تستفيد منها

أخي الفاضل إبراهيم جرب الملف التالي Test This.rar