نجوم المشاركات

تفضل أ.أيمن المطلوب بالمرفق المصنف1.rar

أخى الكريم ياسر بارك الله فيك وجازاكم خيرا طورت الكود بحيث يتم إنشاء مصنف لكل توجيه ويستثنى "بدون توجيه" ، كما يستثنى "بدون توجيه" في مصنف "قوائم التوجهات الكلية" ويصبح الكود بهذا الشكل : Sub MOKHTARTSET2() Dim myDir As String, C As Range, WB As Workbook, NWB As Workbook, Rng1 As Range, Rng2 As Range Set WB = ThisWorkbook myDir = ActiveWorkbook.Path & "\" & "My Workbook" Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next MkDir myDir On Error GoTo 0 '--------------------------------------------------------------------------------- WB.Sheets("Final").Select Range("D7:S7").Select Selection.AutoFilter ActiveSheet.Range("$D$7:$S$27").AutoFilter Field:=16, Criteria1:="<>بدون توجيه", Operator:=xlAnd Columns("F:Q").Select Selection.EntireColumn.Hidden = True Set Rng1 = WB.Sheets("Final").Range("d7:s27").SpecialCells(xlCellTypeVisible) Rng1.Select Selection.Copy Set NWB = Workbooks.Add ActiveSheet.Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A4:D24").Select With Selection .HorizontalAlignment = xlCenter .Font.Size = 10 .Font.Bold = True .Interior.ColorIndex = 38 .Borders.LineStyle = xlContinuous End With ActiveSheet.Range("B2") = "قـــــوائم التوجهـــــــات الكلـــــية " NWB.SaveAs Filename:=myDir & "\" & "قـــــوائم التوجهـــــــات الكلـــــية " & ".xlsx", CreateBackup:=False NWB.Close WB.Activate WB.Sheets("Final").Cells.Select Selection.EntireColumn.Hidden = False Selection.AutoFilter Range("X11").Select '-------------------------------------------------------------------------------------- For Each C In Sheets("Final").Range("U12:U23") WB.Sheets("Final").Range("AA1").Value = C.Value ' ------------------------------------------------------------------------------- WB.Sheets("Final").Activate Range("D7:S7").Select Selection.AutoFilter ActiveSheet.Range("$S$11:$S$27").AutoFilter Field:=16, Criteria1:="<>بدون توجيه", Criteria2:="=" & C.Value, Operator:=xlAnd Range("F:Q,S:S").Select Selection.EntireColumn.Hidden = True Set Rng2 = WB.Sheets("Final").Range("D7:R27").SpecialCells(xlCellTypeVisible) Rng2.Select Selection.Copy Set NWB = Workbooks.Add ActiveSheet.Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A4:D10").Select With Selection .HorizontalAlignment = xlCenter .Font.Size = 10 .Font.Bold = True .Borders.LineStyle = xlContinuous .Interior.ColorIndex = 38 End With ActiveSheet.Range("B2") = "الموجهون الى" ActiveSheet.Range("C2") = C.Value NWB.SaveAs Filename:=myDir & "\" & C.Value & ".xlsx", CreateBackup:=False NWB.Close WB.Activate WB.Sheets("Final").Cells.Select Selection.EntireColumn.Hidden = False Selection.AutoFilter Range("A1").Select '----------------------------------------------------------------------------------- Next C Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub أشكرك أستاذى العزيز . Pupils Distribution According To Marks & Wishees by mokhtar v2 .rar

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

بارك الله فيك أخي الحبيب الغالي مختار زيادة في الخير وإثراءً للموضوع إليك الحل التالي ..حيث يتم إنشاء مصنف لكل توجيه ويستثنى "بدون توجيه" ، كما يستثنى "بدون توجيه" في مصنف "قوائم التوجهات الكلية" يتم إنشاء مجلد في نفس مسار المصنف الحالي باسم Results يتم تصدير المصنفات به Sub YasserKhalil() Dim rngData As Range, rngToCopy As Range, arrFilter, I As Long, J As Long Application.DisplayAlerts = False Application.ScreenUpdating = False If Len(Dir(ThisWorkbook.Path & "\Results", vbDirectory)) = 0 Then MkDir ThisWorkbook.Path & "\Results" End If Set rngData = Range("D7:S" & Cells(Rows.Count, "D").End(xlUp).Row) arrFilter = Application.Transpose(Range("U12:U" & Cells(Rows.Count, "U").End(xlUp).Row)) ReDim Preserve arrFilter(1 To UBound(arrFilter) + 1) arrFilter(UBound(arrFilter)) = "<>بدون توجيه" For I = 1 To UBound(arrFilter) ActiveSheet.AutoFilterMode = False rngData.AutoFilter Field:=16, Criteria1:=arrFilter(I) J = rngData.Columns(1).SpecialCells(xlCellTypeVisible).Count If J = 1 Then GoTo skipper Set rngToCopy = Intersect(Union(Columns("D:E"), Columns("R:S")), rngData.SpecialCells(xlCellTypeVisible)) Workbooks.Add ActiveSheet.Cells.Clear rngToCopy.Copy Range("B5") With Range("B2:E3") .HorizontalAlignment = xlCenter .VerticalAlignment = xlCenter .MergeCells = True .Font.Size = 20 .Value = IIf(I < UBound(arrFilter), arrFilter(I), "قوائم التوجهات الكلية") End With If I < UBound(arrFilter) Then Columns("E").Delete ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Results\" & arrFilter(I) & ".xlsx" Else ActiveWorkbook.SaveAs ThisWorkbook.Path & "\Results\" & "قوائم التوجهات الكلية" & ".xlsx" End If ActiveWorkbook.Close skipper: Next I ActiveSheet.AutoFilterMode = False Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub تقبل تحياتي Export Workbooks Using Filter Method.rar

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

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

هو ايه اللي يجري بالمشاركات يطلبون كود و لما تضعه يطلبون معادلة و العكس بالعكس

أخي الكريم يرجى تغيير اسم الظهور للغة العربية ويرجى الإطلاع على رابط التوجيهات في الموضوعات المثبتة في المنتدى لكيفية التعامل مع المنتدى بشكل جيد إليك الكود التالي عله يفي بالغرض Sub TestRun() Dim SHP As Shape, strX As String Dim lColLeft As Long, lColRight As Long Dim LR As Long Application.ScreenUpdating = False With Sheet1.Shapes(Application.Caller) If Mid(.Name, 1, 9) = "Rectangle" Then strX = Mid(.TextFrame.Characters.Text, InStr(.TextFrame.Characters.Text, ": ") + 2) lColLeft = .TopLeftCell.Column: lColRight = .BottomRightCell.Column With Sheet2 LR = .Cells(Rows.Count, 1).End(xlUp).Row + 1 .Range("A" & LR).Value = strX .Range("B" & LR).Value = Sheet1.Cells(2, lColRight).Value .Range("C" & LR).Value = Sheet1.Cells(2, lColLeft).Value End With End If End With Application.ScreenUpdating = True End Sub يتم ربط الشكل بالكود عن طريق كليك يمين ثم Assign Macro ثم اختيار اسم الماكرو TestRun لا تنسى أن تحدد أفضل إجابة إذا أعجبتك المشاركة كما لا تنسى أن تضغط كلمة "أعجبني هذا" إذا أعجبك المحتوى تقبل تحياتي وتوجيهاتي Application Caller & Shapes YasserKhalil.rar

حبيبي الغالي وأخي في الله أ / علاء رسلان شكرا لدعائك الطيب ومرورك دائما علي موضوعاتي الذي يسعدني دائما وبالنسبة للبدء بتحية الإسلام فهو أمر مفروغ منه بس ممكن يكون سهو تقبل خالص تحياتي وتقديري

أخي الحبيب أبو حنين توضع الأكواد بين أقواس الكود والتي تكون بهذا الشكل من خلال محرر الكتابة <> ابحث عن هذا الشكل جرب الكود التالي ..لم أجرب الكود Sub PDF_SALAM() Dim MyName As String MyName = "D:\MANAFIST TAREK\PDF\MANAFIST TAREK TO SALAM_" & Format(Date + 1, "dd-mm-yyyy") & ".pdf" Range("C45").Select Range("C45").Select Sheets(Array("زراعى", "صحراوى", "طائرة")).Select Sheets("طائرة").Activate If MsgBox("هل تريد إرسال الملف المرفق إيميل أم لا؟", vbYesNo, "Send Email") = vbNo Then GoTo 1 OutlMail_PDF MyName, "Mohamed.Tawfek@khalda-eg.com;Mohamed.Amria@khalda-eg.com;mohamed.abonour@khalda-eg.com", "مانفست حقول طارق", _ vbNewLine & "مع تحيات ..إدارة الشئون الادارية بحقول طارق", False 1 MyMsg = MsgBox("هل انت متاكد من اتمام عمليه الحفظ", 4, "تنبيه") If MyMsg = 6 Then ChDir "D:\MANAFIST TAREK" ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ MyName, Quality:=xlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _ False Else MsgBox "لم يتم الحفظ" End If Sheets("طائرة").Select ActiveWindow.SmallScroll Down:=-12 Range("B5").Select End Sub Function OutlMail_PDF(FileNamePDF As String, StrTo As String, StrSubject As String, StrBody As String, Send As Boolean) Dim OutApp As Object Dim OutMail As Object Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) On Error Resume Next With OutMail .To = StrTo .CC = "" .BCC = "" .Subject = StrSubject .Body = StrBody .Attachments.Add FileNamePDF If Send = True Then .Send Else .Display End If End With On Error GoTo 0 Set OutMail = Nothing Set OutApp = Nothing End Function شوف أنا وضعت الكود بين أقواس تنصيص عملت كليك على العلامة <> ثم لصقت الكود بداخله (ولكن يراعى عند نسخ الكود أن يكون اتجاه الكتابة باللغة العربية حتى لا تظهر اللغة العربية بحروف غريبة) تقبل تحياتي

السلام عليكم ورحمة الله وبركاته جزاكم الله خيراً... أرى أن أخي ياسر يسّر الله خيري الدنيا والآخرة وفتح له أبواب رحمته وأسره بما أعطاه قد نسي لكثرة مشاغله تحية الإسلام " السلام " لكنها ستكون بإذن الله بوابة عمله الدؤوب فما أحيلاها من كلمة تبادر بها إخوتك لتتحات ذنوبنا - ومن منا بريء منها - كما تحاتّ أوراق الشجر في فصل الخريف وسنرضي خاطرك أخي علاء بما يسرك إن شاء الله تعالى..لأنني أعلم أن أخانا المهندس لن يرد لنا طلباً. ولكنني أعتب عليك أخي علاء لأنك لم تبدأ أو تختم مشاركتك2 بالسلام الذي تحض عليه. لكم مني كل محبة واحترام وتقدير والسلام عليكم ورحمة الله وبركاته ملاحظة :أستاذ ياسر جزاك الله خيراً ... أود أن تكون باللغة العربية لتعم الفائدة.

تفضل اخي هذا المطلوب اضغط افضل اجابة ليكون الموضوع منتهَ find1.zip

اخى الكريم ممكن تستخدم برنامج Smart Install Maker وده شرحه لأختنا الكريمه زهره والبرنامج والسريال بالمرفقات بالتوفيق إن شاء الله شرح.rar smart install maker 5.04.zip

السلام عليكم ورحمة الله وبركاته أستأذن أخى وأستاذى العزيز ياسر خليل وأشارككم بهذه المحاولة التى أعتبرها بداية جيدة أتفق مع رأى أستاذى العزيز ياسر الأخير بالمشاركة 9 حيث يتم تصدير كل توجيه الى مصنف مستقل ويتم تصدير كل التوجيهات الى مصنف عام يجمع الكل فهو الأيسر والأسهل والأقرب الى الصواب فبدلا من أن يكون هناك زر أمر لكل توجيه على حدا وأكواد متعددة يكفى زر واحد وكود واحد يقوم بذلك : الكود : Sub MOKHTARTSET() Dim myDir As String, C As Range, WB As Workbook, NWB As Workbook, Rng1 As Range, Rng2 As Range Set WB = ThisWorkbook myDir = ActiveWorkbook.Path & "\" & "My Workbook" Application.ScreenUpdating = False Application.DisplayAlerts = False On Error Resume Next MkDir myDir On Error GoTo 0 '--------------------------------------------------------------------------------- WB.Sheets("Final").Select Columns("F:Q").Select Selection.EntireColumn.Hidden = True Set Rng1 = WB.Sheets("Final").Range("d7:s27").SpecialCells(xlCellTypeVisible) Rng1.Select Selection.Copy Set NWB = Workbooks.Add ActiveSheet.Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A4:D24").Select With Selection .HorizontalAlignment = xlCenter .Font.Size = 10 .Borders.LineStyle = xlContinuous End With ActiveSheet.Range("B2") = "قـــــوائم التوجهـــــــات الكلـــــية " NWB.SaveAs Filename:=myDir & "\" & "قـــــوائم التوجهـــــــات الكلـــــية " & ".xlsx", CreateBackup:=False NWB.Close WB.Activate WB.Sheets("Final").Cells.Select Selection.EntireColumn.Hidden = False Range("X11").Select '-------------------------------------------------------------------------------------- For Each C In Sheets("Final").Range("U12:U23") WB.Sheets("Final").Range("AA1").Value = C.Value ' ------------------------------------------------------------------------------- WB.Sheets("Final").Activate Range("D7:S7").Select Selection.AutoFilter ActiveSheet.Range("$D$7:$S$27").AutoFilter Field:=16, Criteria1:="=" & C.Value, Operator:=xlAnd Range("F:Q,S:S").Select Selection.EntireColumn.Hidden = True Set Rng2 = WB.Sheets("Final").Range("D7:R27").SpecialCells(xlCellTypeVisible) Rng2.Select Selection.Copy Set NWB = Workbooks.Add ActiveSheet.Range("A4").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False Range("A4:D10").Select With Selection .HorizontalAlignment = xlCenter .Font.Size = 10 .Borders.LineStyle = xlContinuous End With ActiveSheet.Range("B2") = "الموجهون الى" ActiveSheet.Range("C2") = C.Value NWB.SaveAs Filename:=myDir & "\" & C.Value & ".xlsx", CreateBackup:=False NWB.Close WB.Activate WB.Sheets("Final").Cells.Select Selection.EntireColumn.Hidden = False Selection.AutoFilter Range("A1").Select '----------------------------------------------------------------------------------- Next C Application.ScreenUpdating = True Application.DisplayAlerts = True End Sub الكود ينتج عنه الملفات المطلوبة داخل مجلد باسم My Workbook فى مسار الملف أرجو أن يكون هو المطلوب. Pupils Distribution According To Marks & Wishees by mokhtar .rar

..... شاهدوا المرفق أخوكم عماد الحسامي

لدي عدد من الملفات في لاكسل وارغب عملها مع محترف اكسل بشروط 1- ان يكون العمل بمقابل مادى 2- ان يكون العمل بمقابل مادى 3- ان يكون العمل بمقابل مادى 4- لاارغب العمل بالمجان نهااااااااااااائي يعني بزنس ( ...) قد يقول احدكم اطرح موضوعك والجميع يساهم في حله . مجاني ..( هذا الكلام لا يصلح لان العمل خاص اولا وثانيا عندما يكون العمل مجاني فانني احتمال انتظر اسبوع او شهر او اكثر لاجل حله ) وانا ارغب انجازه باسرع وقت انا ارغب عمل مقابل دفع مادة للعمل ....... ارغب انجازه بسرعة ارجو من لديه القدره على العمل التواصل عبر الخاص مشكوووووورين

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

وهذا للفائدة .. ممكن يوضع داخل البرنامج ولا يصل له بطريقة أو بأخرى الا مصمم البرنامج ... مثلا يوضع في نموذج ويضاف زر امر وفي حدث عند النقر يوضع الكود التالي : Dim prop As Property On Error GoTo SetProperty Set prop = CurrentDb.CreateProperty("AllowBypassKey", dbBoolean, False) CurrentDb.Properties.Append prop SetProperty: If MsgBox("هل ترغب بتفعيل مفتاح الشفت ؟", vbYesNo, "تفعيل عمل الشفت") = vbYes Then CurrentDb.Properties("AllowBypassKey") = True Else CurrentDb.Properties("AllowBypassKey") = False End If بالتوفيق ..

أخي الكريم خالد هلال إليك الملف التالي عله يفي بالغرض Sub Tarhil() Dim WS As Worksheet, SH As Worksheet Dim LR As Long Set WS = Sheets("الإيصال"): Set SH = Sheets("اليومية") LR = SH.Cells(Rows.Count, 6).End(xlUp).Row + 1 Application.ScreenUpdating = False With SH .Range("A" & LR) = LR - 4 .Range("B" & LR) = WS.Range("G3") .Range("C" & LR) = WS.Range("G2") .Range("D" & LR) = WS.Range("B4") .Range("E" & LR) = WS.Range("B5") .Range("F" & LR) = (WS.Range("B6") - Int(WS.Range("B6"))) * 100 .Range("G" & LR) = Int(WS.Range("B6")) .Range("H" & LR) = WS.Range("D5") .Range("I" & LR) = WS.Range("B7") WS.Range("G3") = WS.Range("G3") + 1 End With MsgBox "تم الترحيل بنجاح", vbInformation Application.ScreenUpdating = True End Sub لا تنسى أن تحدد أفضل إجابة ليظهر الموضوع مجاب ومنتهي كما لا تنسى أن تضغط أعجبني هذا إذا أعجبتك المشاركة وأدت الغرض تقبل تحياتي Tarhil YasserKhalil.rar

السلام عليكم ورحمة الله وبركاته ,, يبدو اختي الكريمة وبحسب الرسالة الأولى ان نظام الويندوز لديك هو 64 بت ,, والوحدة النمطية معدة للـ 32 بت . حاولي تغيير الرقم 32 الموجود في الوحدة النمطية إلى 64 وجربي .. اذا ما ظبط ننتظر احد الأعضاء الكرام للإفادة ... بالنسبة لي جربت المرفقين ولم اواجه الا ما اشار اليه الأخ سلمان .. في الرسالة الثانية. نظام تشغيل الويندوز لدي هو 32 بت. بالتوفيق .

السلام عليكم جزاك الله كل الخير والتقدير اخى الحبيب ياسر خليل تم المطلوب بصورة كامله جزاك الله كل الخير

الف شكر اخي ياسر الان صار يعمل 100% ربنا يبارك فيك ويسعدك كما تحاول بكل جهدك تسعد الناس

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

أخي وأستاذي القدير الذي مقامه عندي في مقام والدي أ / محمد كل الشكر والتقدير والإحترام لكلماتك الرائعة التي تسعدني بها دائما بالنسبة لتحية الإسلام فهى سهو مني أرجوا تقبل إعتزاري وشكرا لدعائك الطيب جزاك الله خير الجزاء ت السلام عليكم أخي وحبيبي في الله م/ياسر...أثلجت صدري بكلماتك القيمة.. بصراحة أسعدتني بكلماتك هذه....وأنا مدين لك باعتذار إن بدر مني ما يسوؤك.. تقبل تحياتي العطرة ..السلام عليكم

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

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

ها هى طريقة بدون عمود مساعد لعل ذلك هو المطلوب جرب المرفق نموزج.rar ........................... هذه معادلة صفيف بعد كتابتها لا يتم الضغط على انتر وإنما Ctrl+Shift+Enter

أخي الكريم أيمن إبراهيم شوف مشاركة الأخ الفاضل خالد الرشيدي رقم 2 وشوف مشاركتك رقم 3 ركز على الجزء اللي فيه كلمة "أعجبني هذا" هتلاقي إنك معملتش إعجاب للأخ الحبيب خالد مع إنه يستاهل ، وهو عمل إعجاب على ردك اللي بتشكره فيه (عجبت لك يا أستاذنا أيمن ... متفوتش عليك دي) تقبلوا وافر تقديري واحترامي

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

أخي الكريم أبو لجين إليك التعديل ليناسب طلبك إن شاء المولى Function AnglesAverage(Rng As Range) Application.Volatile Dim Cell As Range, Counter As Long, Temp For Each Cell In Rng If Cell.Value < 180 And Not IsEmpty(Cell) Then Temp = Temp + Cell.Value + 360 Else Temp = Temp + Cell.Value End If If Not IsEmpty(Cell) Then Counter = Counter + 1 Next Cell AnglesAverage = Temp / Counter If AnglesAverage >= 360 Then AnglesAverage = AnglesAverage - 360 End Function قم بإدراج الكود مكان الكود القديم واذهب لورقة العمل وإذا وجدت النتائج لم تتغير يرجى الضغط على Ctrl + Shift + F9 لا تنسى أن تحدد أفضل إجابة ، ولو فيها رزالة مني متنساش تضغط على "أعجبني هذا"

ألف الف شكر اخي ياسر الكود يعمل الان 100% و الورقة مخفية بارك الله فيك علي ما تقدمة من خدمة لكل الناس ولا تطلب سوي الدعاء اسم ابني ياسر و الاسم الحقيقي حسن

السلام عليكم ورحمة الله وبركاته الأخوة الأكارم ما كنت أعلمه أن الدائرة تنقسم إلى 360 ْ وقد قرأت استغراب أخي علاء أن الدائرة أصبحت 350 ْ سبحان مغير الأحوال من حال إلى حال راجياً من الأخوة المشرفين العمل على تغيير العنوان بداية ...لا أعلم أن الزوايا دائرية ....وذلك لأنني لم أدرس الثانوية العلمي بل الأدبي. والسلام عليكم.

أرجوا من الله العلى القدير أن ينال رضاكم ويستفاد منه الجميع تقبلوا خالص تحياتى دوال الاكسيل بالشرح.rar

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

ساذكر لك طريقة سهلة : اذهب لخصائص مربع التحرير والسرد ومن تبويب بيانات وعند الخاصية "نموذج تحرير عناصرالقائمة" اختر النموذج school واعرض النموذج وافتح الكمبو بكس ستجد ايقونة في اخر القائمة لفتح النموذج وعند العودة ستجد البيانات الجديدة !! وهنا لا داعي لزر الامر اضافة بالتوفيق ونتابع الفقرة 2)

اهلا بك اخينا كوماندير مالفائدة من ما طلبت ؟ حيث لم تظهر لي ونريد ان نستفيد ! بوجهة نظري انه العكس : عندما تنتقل بين السجلات سيظهر العملاء في القائمة وحسب التاريخ وبالنقر على العميل في القائمة يظهر العميل في النموذج ! هذا ولك ماطلبت باذن الله لاحقا وبعد معرفة الفائدة ولكن بتظليل العنصر وليس بتغيير تنسيقه ؟ لانه هناك تحدي في تنسيق عنصر القائمة في الاكسس فما بالك في احد صفوف القائمة !!!! تحياتي

ربما لم أفهم المطلوب بشكل جيد قمت بعمل دالة معرفة تتعامل مع كل زاوية .. إذا كانت الزاوية أقل من 180 يتم إضافة 360 لها وهكذا ثم يتم عد الزوايا وحساب المتوسط على حسب العدد أرجو أن يكون المطلوب .. Function AnglesAverage(Rng As Range) Dim Cell As Range, Counter As Long, Temp For Each Cell In Rng If Cell.Value < 180 And Not IsEmpty(Cell) Then Temp = Temp + Cell.Value + 360 Else Temp = Temp + Cell.Value End If If Not IsEmpty(Cell) Then Counter = Counter + 1 Next Cell AnglesAverage = Temp / Counter End Function تقبل تحياتي Angles Average UDF Function.rar

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

الله الله عليك يا أبا البراء رائع هذا الكود رغم أن فيه شوية كلاكيع استفسار : ليه تم استثناء مصنف لــ "بدون توجيه" ، كما تم استثناء "بدون توجيه" في مصنف "قوائم التوجهات الكلية" مع أن من المفروض أن يعامل غير الموجهين كغيرهم فهم جزء من الكل ولا ده طلب لأخونا أشرف .دى نقطة النقطة الثانية فى ملف أخونا أشرف وضع أسماء التوجهات النهائية فى النطاق "U12:U23" وفيهم التوجه التسويق 3 مع أنه مش موجود فى العمود S وأنا فى كودى اعتمدت على هذا النطاق لعمل مصنف لكل توجه موجود بهذا النطاق وبالتالى فى مخرجات كودى طلع مصنف التسويق 3 فارغ بدون أسماء ليه ؟؟؟؟؟؟؟؟؟؟؟؟؟ لأن أصلا مفيش حد تم توجيهه الى التسويق 3 وأخوك ضليع جدا فى المعادلات وعايز معادلة فى النطاق "U12:U23" تاخذ من العمود S أسماء التوجهات النهائية بدون تكرار وتستثنى بدون توجيه وبكده لا يظهر فى مخرجات كودى أى مصنف فارغ ياريت أكون واضح فى طلبى تحياتى لك

السلام عليكم الحل ليس لى و لكن بحثت فى موضوع الاستثمار و توصلت لنتيجة بإستخدام صيغة IRR معدل العائد الداخلى و وجدت النتائج كالتالى على ترتيب البدائل ( العروض) المتاحة 9% - 13% - 10%- 11% و على ذلك أرى ان الأفضل البديل الثانى ( العرض) و الله أعلم و فى انتظار الأجابة .

تفضل رابط جديد http://www.officena.net/ib/?showtopic=42659

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

شكرا لمرورك الكريم أخى الحبيب / علاء رسلان وشكرا لدعائك الطيب ومبروك على الترقية المستحقة

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

برجاء التوضيح ما هي الشروط التى تقصدها، وعلى أى أساس يتم تحديد الرغبات للاسم؟؟

البرنامج أكسيس 2010 تنسيق 2003 اسم المستخدم 1 السري 1

و عليكم السلام و رحمة الله و بركاته طوال حياتى الدراسية رحلة أستغرقت 17 عام منها عام رسبت فيه فى الثانوية العامة بسبب مادة الكيمياء ، لم يمر موضوع بهذا الشكل طوال فترة الدراسة و كنت متفوقا فى الرياضيات و كل ما يتعلق بها و كنت بين الزملاء مشهورا بالعبقرى .. لم أدرس شئ بهذا الشكل يقول ان المتوسط الحسابى لزوايا الدائرة يختلف عن المتوسط الحسابى لأى شئ آخر هذا شئ .. و ما أعلمه أن المتوسط الحسابى هو مجموع القيم على عددها و لذلك 330 و 10 متوسطها الحسابى هو 170 و ليس 140 و تذكر بالنسبة للدائرة انها 350 .. لا بد أنك تقصد شئ آخر ؟ ستجعلنى بعد هذا العمر الطويل الذى يقترب من الأربعين عام أراجع معلوماتى بل قد أعيد دراسة المناهج كلها لعل هناك شئ فاتنى منها و لم أنهل منه بعد ؟ يرجى التوضيح فالموضوع قلب أفكارى رأسا على عقب .. دمت بخير و أعزك الله .

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

الأخ الحبيب أبو نبأ إليك الملف المرفق عله يفي بالغرض Filter & Extract Duplicates.rar

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