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

السّلام عليكم و رحمة الله و بركاته أستاذي الغالي " خالد الشّاعر " عملت تغيير بملف أستاذنا القدير " ياسر خليل أبو البراء " .. بارك الله فيه و جزاه الله خيرًا حاضرًا و غائبًا و زادها بميزان حسناته قمت بتحريك وضعية الجدول لترى الفرق بين الملف الأول و هذا الملف .. لاحظ أنّ العمود الخاص بالتّرقيم هو العمود التّاسع العمود الخاص بالتاكست بوكس 1 هو العمود العاشر .. وهكذا تصاعديًا .. الصف الذي بدأنا به الترقيم هو الصف الرّابع .. أدخل لو سمحت لمحرّر الأكواد واكتشف الفرق بين هذا الملف و الملف الأصلي الأول ستجد أنّ الأمر أبسط ممّا تتخيّل فائق إحتراماتي UserForm TextBox Input YasserKhalil.rar

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

أخي الكريم أبو راكان إليك الكود التالي يتم وضعه في موديول عادي Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function SetWindowLong Lib "User32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare Function GetWindowLong Lib "User32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long Private Declare Function SetWindowPos Lib "User32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Declare Function GetWindowRect Lib "User32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Const GWL_STYLE = (-16) Private Const WS_CAPTION = &HC00000 Private Const WS_MAXIMIZEBOX = &H10000 Private Const WS_MINIMIZEBOX = &H20000 Private Const WS_SYSMENU = &H80000 Private Enum ESetWindowPosStyles SWP_SHOWWINDOW = &H40 SWP_HIDEWINDOW = &H80 SWP_FRAMECHANGED = &H20 SWP_NOACTIVATE = &H10 SWP_NOCOPYBITS = &H100 SWP_NOMOVE = &H2 SWP_NOOWNERZORDER = &H200 SWP_NOREDRAW = &H8 SWP_NOREPOSITION = SWP_NOOWNERZORDER SWP_NOSIZE = &H1 SWP_NOZORDER = &H4 SWP_DRAWFRAME = SWP_FRAMECHANGED HWND_NOTOPMOST = -2 End Enum Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Sub ShowTitleBar(bShow As Boolean) Dim lStyle As Long Dim tRect As RECT Dim xlHnd As Long xlHnd = Application.hwnd GetWindowRect xlHnd, tRect If Not bShow Then lStyle = GetWindowLong(xlHnd, GWL_STYLE) lStyle = lStyle And Not WS_SYSMENU lStyle = lStyle And Not WS_MAXIMIZEBOX lStyle = lStyle And Not WS_MINIMIZEBOX lStyle = lStyle And Not WS_CAPTION Else lStyle = GetWindowLong(xlHnd, GWL_STYLE) lStyle = lStyle Or WS_SYSMENU lStyle = lStyle Or WS_MAXIMIZEBOX lStyle = lStyle Or WS_MINIMIZEBOX lStyle = lStyle Or WS_CAPTION End If SetWindowLong xlHnd, GWL_STYLE, lStyle Application.DisplayFullScreen = Not bShow SetWindowPos xlHnd, 0, tRect.Left, tRect.Top, tRect.Right - tRect.Left, tRect.Bottom - tRect.Top, SWP_NOREPOSITION Or SWP_NOZORDER Or SWP_FRAMECHANGED End Sub Sub Hide_Application_Title() ShowTitleBar False End Sub Sub Show_Application_Title() ShowTitleBar True End Sub يمكنك تنفيذ إخفاء شريط العنوان باستدعاء الماكرو المسمى Hide_Application_Title ولاظهار العنوان مرة أخرى استدعي الماكرو المسمى Show_Application_Title

انا كنت فاكر مشكلتك ترتيب بس التكست بوكس جاري عمل اللازم انتظر تفضل اخي ترتيب الفورمة.rar

حفظك الله اخي ياسر خليل كلنا نتعلم من بعض احبك الله الذي احببتنا فيه تقبل تحياتي وشكري لشخصكم النبيل

أخي الغالي أبو نصار لا حرمنا الله من إبداعاتك ولا منك أبداً تقبل وافر تقديري وحبي في الله

السلام عليكم ان كان كجمال واعطاء مساحه احبذ الكود التالي عند فتح المصنف "Auto_Open" ينفذ اخفاء عند اغلاق المصنف "Auto_Close" ينفذ اظهار Sub Auto_Open() Ali_Acc False End Sub Sub Auto_Close() Ali_Acc True End Sub Sub Ali_Acc(Bll As Boolean) With Application .DisplayFormulaBar = Bll .ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"" ," & Bll & ")" .ActiveWindow.DisplayHeadings = Bll If Bll Then .ThisWorkbook.Close SaveChanges:=Not Bll End With End Sub

السلام عليكم انسخ الكود التالي الى حدث الورقة المسماه "الصفحة 2" Private Const My_Rng_Adrs As String = "$A$3:$D$55000" Private Const Area_Prnt As String = "$C$7:$E$15" Dim Ar_1() As Variant Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Range("A7:A1000"), Target) Is Nothing Then MsgBox "" If Target <> Empty Then Dim Wr As Worksheet: Set Wr = Sheets("الصفحة 3") With Wr .Cells(7, 4) = Target .Cells(8, 4) = Target.Offset(0, 1) .Cells(9, 4) = Target.Offset(0, 2) .PageSetup.PrintArea = Area_Prnt .PrintPreview .Cells(7, 4) = "": .Cells(8, 4) = "": .Cells(9, 4) = "" End With Cancel = False Set Wr = Nothing End If End If End Sub Private Sub Worksheet_Change(ByVal Target As Range) If Target.Address = "$A$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CStr(Target), 1) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If If Target.Address = "$C$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CDate(Target), 3) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If If Target.Address = "$E$5" Then Range(Range("A7"), Range("D7").End(xlDown).Resize(1, 4)).ClearContents If Ali_Serch(CStr(Target), 4) = True Then Range("A7").Resize(UBound(Ar_1, 1), UBound(Ar_1, 2)) = Ar_1() End If Erase Ar_1 End If End Sub Private Function Ali_Serch(Trget As String, Col As Long) As Boolean Dim Ar Dim Rng As Range Dim C, x, i, XX, Xi, Xt Dim Data_1 Dim Wrsh As Worksheet Set Wrsh = Sheets("الصفحة 01") With Wrsh If Col = 3 And Not IsDate(Trget) Then MsgBox "صيغة التاريخ التي كتبتها غير صحيحه !!", vbExclamation, "إدخال خاطئ !!": Exit Function Set Rng = .Range(My_Rng_Adrs) Ar = Rng.Value ReDim Preserve Ar_1(1 To Rng.Rows.Count, 1 To 4) For x = LBound(Ar, 1) To UBound(Ar, 1) XX = Ar(x, Col): Xi = Trim(Ar(x, 1)): Xt = Trim(Ar(x, 2)) If Col = 3 Or Col = 4 Then Data_1 = Val(XX) ElseIf Col = 1 Then Data_1 = CStr(Xi & " " & Xt) ElseIf Col = 3 Then Data_1 = CDate(DateSerial(Year(XX), Month(XX), Day(XX))) End If If Not Data_1 = Empty Then If Data_1 Like Trget Then Ali_Serch = True i = i + 1 For C = 1 To 4 Ar_1(i, C) = IIf(C = 3, Format(Ar(x, C), "dd/mm/yy"), CStr(Ar(x, C))) Debug.Print Ar(x, C) Next C End If End If Next x End With Set Rng = Nothing: Set Wrsh = Nothing End Function بعد كتابة الاسم او التاريخ او رقم التسجيل اضغط انتر ستظهر النتائج اسفل جدول البحث انقر مرتين على نتيجة البحث في العمود "A" الاسم الاول سيطبع لك النتيجه جرب وابلغنا بالنتائج تحياتي تم اضافة المرفق وبه الكود اعلاه تجربة_111.rar

اخي الكريم ياسر خليل الفائده من استخدام الكود بالطريقه التي سردتها بالمشاركه السابقه ان لاتحمل كاهل الملف بالهيبرلينك حتى يصبح بطيئ جدا عند الفتح وان ولايوقف عند الخليه 650000 كحد اعلى للهيبرلينك فقط بل ينفذ الكود حتى يصل عند التوليف "ZZZZ" كأنه كتب عنوان على الخلايا فقط ونستخدم العنوان كهيبر لينك عند النقر عليه وبالامكان استخدام الكود لايحذف الهيبرلينك الا حين يصل الى الحد الاعلى بإضافة بسيطه هذه اضافه لااحبذها الافضل التعامل مع كل خليه كي لا يكبر حجم الملف ويصبح بطيئ هذا المرفق وبه الكود لحدث الصفحه وكود انشاء العناوين If ActiveSheet.Hyperlinks.Count >= 65530 Then For Each R In ActiveSheet.Hyperlinks If R.TextToDisplay > "" Then R.Delete: Exit For Next End If شرح كود الهايبر لنك_111.rar

السلام عليكم ورحمة الله أخي الكريم ياسر، هذه محاولة في المرفق بالاستعانة بعمود إضافي (ملون بالأخضر) فيه معادلة تقوم بحساب مجموع: (عدد مرات ظهور الرقم 1 في الصف مضروب في 1000) و (عدد مرات ظهور الرقم 2 في الصف مضروب في 100) و (عدد مرات ظهور الرقم 3 في الصف مضروب في 10) و (عدد مرات ظهور الرقم 4 في الصف مضروب في 1) بالنسبة للأعمدة المعنونة بـ "Rank" ثم في العمود "Total Rank" وضعت الدالة RANK لترتيب المجاميع المحصل عليها... (بالتأكيد معادلات المجاميع تتغير حسب عدد المراتب)... بن علية Rank.rar

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

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

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

السلام عليكم هكذا بيكون Private Sub Workbook_SheetActivate(ByVal Sh As Object) Ap_A False With Sh.UsedRange .Columns.EntireColumn.AutoFit '' الاعمدة .Rows.EntireRow.AutoFit '' الصفوف .Borders.Color = 1 '' البوردر With .Font .Name = "Times New Roman" '' اسم الخط .Size = 10 '' حجم الخط End With End With Ap_A True End Sub Private Function Ap_A(Bn As Boolean) With Application .Calculation = IIf(Bn, -4105, -4135) .ScreenUpdating = Bn .EnableEvents = Not Bn End With End Function

السّلام عليكم و رحمة الله و بركاته أخي الكريم " أبو عبد الرّحمن البغدادي " .. يبدو أنَّ قدري مرتبط بقدرك لأنّي غالبًا ما أشارك بمواضيعك .. كان يمكن أن أرسل لك الملف جاهزًا لكن فضّلت أخي الفاضل أن تحاول إنجاز ذلك بنفسك .. لاحظ أخي الكريم في شيت البيانات أنّ عمود صافي الرّاتب هو العمود N وهو العمود رقم 14 .. نذهب الآن إلى محرّر الأكواد .. سنجد أنّ التاكست بوكس الخاصّة بصافي الرّاتب هي التاكست بوكس رقم 10 .. ندخل إلى الأكواد الاآن و نلاحظ .. شاهد الصورة يجب أن تكون التاكست بوكس 10 مرتبطة مع العمود 14 لاحظ السّهم الأحمر و السّهم الأخضر بالصورة رقم 3 .. نجد أنّ التاكست بوكس 10 مرتبطة مع العمود 10 المشار إليه بالسّهم الأخضر .. جرّب تغيير الرقم 10 المشار إليه بالأخضر إلى الرّقم 14 و ستتغيّر النتيجة .. إتّبع نفس المنوال لترتيب أمورك .. و الله المستعان فائق إحتراماتي

السلام عليكم المرفق الاول الشرح والاخر الملف شرح_5.rar البحث بين تاريخين_A.rar

تتميز الفكره بادخال حركات المخزن على صفحات الاكسيل مباشره لا على نوافذ حيث السرعه ستكون اكبر ومن الممكن انزال البيانات Copy و PAST اهدى اليكم الفكره لكل اصدقاء المنتدى مع المطالبه لكل مفكرى المنتدى باى اضافات ممكنه وذلك للافاده للجميع كارته مخزن.rar

السلام عليكم ورحمة الله وبركاته إخواني الكرام أحياناً يصادفنا أن يكون حجم الملف كبير جداً مقارنةً بالبيانات الموجودة بداخل الملف .. فقررت عمل موضوع مفتوح يقوم الأعضاء باقتراح طرق لتقليل حجم الملف .. وإليكم ملف للأخ سليم حاصبيا في أحد الموضوعات ..حجم الملف أكثر من 5 ميجا العبد الفقير لله لديه كود خطير يساهم في حل المشكلة ولكن لن أقدمه الآن (كنوع من التشويق ) في انتظار مشاركاتكم القيمة والمساهمة في حل مشكلة تقابل الجميع وفقكم الله لما يحب ويرضى Last Price SALIM.rar

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

بســــــــــــــــم الله الرحمــــــــــن الرحـــــــــــــــــــــــيم الســــــلام عليكــــــــــــــــم و حمة الله و بركاته اخواننا الكرام ، نظرا لكثرة المشاركات حول تقريب الكسور الارقام ، حبيت اشارككم الوحدة النمطية بـ 3 دوال (RoundUp) (RoundHalf) ( RoundDown) دالة : RoundUp([Number],3) للتقريب رقم 33.3333 الى 3.334 او 3.3331 الى 3.334 و هكذا دالة: RoundHalf([Number],3) للتقريب رقم 33.3336 الى 3.334 او 3.3335 الى 3.333 و هكذا و السبب تسمية الدالة بهذالاسم ، وجود دالة باسم Round في الاكسس و انا سميتها RoundHalf دالة: RoundDown([Number],3) للتقريب رقم 33.3336 الى 3.333 او 3.2231 الى 3.223 و هكذا و المرفق يحوي ملفين الاول للعرض ارقام مقربة حسب تنسيق مثلا: عند اختيار اربع منازل أعشار 5.4400 ، 5.4444 ,5.2000 و الثاني بدون تنسيق مثلا : 5.4444 ، 5.44 , 5.2 ابو عارف Round-RowndUp-RowndDown.rar

المشكله عندك اخي هل انت مفعل امان الماكرو منخفض ام لا ؟ اتبع الفيديو في المرفق اذا لاتعرف الطريقه لتفعيل الماكرو تفعيل الماكرو.rar

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

بالطبع اخي مختار حسين لان الاسم خلال الفترة لم يذكر اكثر من رمره لذا لايوجد تكرار ! اما ماذكرته : يوجد خلل بسيط في كود حدث "Calendar1_Click" في الفورم المسمى "Celndr_Ali" Ali_Rep.Controls(A_Se).Value = Calendar1.Value يستبدل بالتالي لعمل عليه فورمات ليأتي بالتاريخ بالشكل الذي نريده "yyyy/mm/dd" Ali_Rep.Controls(A_Se).Value = Format(Calendar1.Value, "yyyy/mm/dd") اذهب الى كود "ListBox1_Click" في السطر الحلقة التكراريه For ii = 1 To .ListCount - 1 الصح بيكون من 0 كأول سطر في الليست بوكس كالتالي For ii = 0 To .ListCount - 1 اذهب الى خصائص فورم "Ali_Rep" وروح الى خاصية "RightToleft" قيمتها False حولها الى True ان شاء الله ستظهر كما تريد او ضيف السطر التالي في حدث "UserForm_Initialize" Me.RightToLeft = True المرفق بعد تعديل ماذكر مسبقاً البحث بين تاريخين_A2.rar

الطلب.rar

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

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

أخي الكريم خالد إليك التعديل التالي عله يفي بالغرض Edit UserForm.rar

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

تمت اضافة المرفق في المشاركة السابقة اخي مشاكس يقصد الاستاذ ياسر خليل اسم ظهورك تغيره كأسم عربي بدلاً عن "MoChekEs"

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

السّلام عليكم و رحمة الله و بركاته جرّب هذا الملف أخي الكريم " أبو عبد الرّحمن البغدادي " .. أتمنى أن يفي بالغرض فائق إحتراماتي ترتيب الفورمة - ترحيل البيانات.rar

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

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

السلام عليكم اخي ياسر خليل ماقصدت الوصول اليه بهذا الشكل كي تتضح لديك الصورة اي اننا لن نصل للحد الاعلى من الهيبر لينك نستخدم الخليه الحاليه هيبرلينك ومجرد استخدامنا للخليه الحاليه نحذف السابق ارجو ان وصلت الفكره Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, ActiveSheet.UsedRange) Is Nothing Then Dim R As Hyperlink For Each R In ActiveSheet.Hyperlinks If R.TextToDisplay > "" Then R.Delete Next With ActiveSheet .Hyperlinks.Add Anchor:=Target, Address:=Target, SubAddress:="", TextToDisplay:=CStr(Target.Text) End With Set R = Nothing End If End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not Intersect(Target, ActiveSheet.UsedRange) Is Nothing Then Dim R As Hyperlink For Each R In ActiveSheet.Hyperlinks If R.TextToDisplay > "" Then R.Delete Next With ActiveSheet .Hyperlinks.Add Anchor:=Target, Address:=Target, SubAddress:="", TextToDisplay:=CStr(Target.Text) End With Set R = Nothing End If End Sub

أخي الكريم ناصر يبدو أنني حصلت على الكتالوج بالفعل ههههه إليك التعديل في هذا السطر ليناسب طلبك With Sh.Range("A1:D20") بدلاً من السطر With Sh.UsedRange

تفضل المطلوب مساجد .rar

دائما وابدا لابد ان تجد لمسة رمهانية شكرا أستاذ رمهان

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

السلام عليكم وتوصيل المعلومة عن طريق الصور .... بسيط وجميل واضح

أخي الكريم محمد الزريعي فيما يبدو لي أن هناك حد أقصي لعدد الارتباطات التشعبية Hyperlinks والحد الأقضى هو 65530... وذلك في كل الإصدارات ... للأسف لن تتمكن من تنفيذ الكود وسيتوقف عند نفس النقطة في كل مرة .. للتأكد من صحة كلامي قم بتحديد الأعمدة التي بها الارتباطات وانظر في شريط الحالة لترى الرقم بنفسك 65531 ..الارتباط الأخير توقف !!! زاد عن الحد أرجو أن تكون المعلومة قد أنهت المشكلة لديك وعرفت سبب المشكلة حتى ترتاح رأسك اللي دوختها !! وفي انتظار رأي بقية الخبراء

جزاكم الله خيرا وجزيل الثواب اخ محمد عصام ويمكن اضافة العدد 1 على التاريخ او انقاصه فهو بمثابة زيادة يوم او انقاصه ! فالتعبير في مثال الاستاذ يوسف ممكن ان يكون : Me.txtDate = Me.txtDate + 1 للزيادة و -1 للانقاص تحياتي

السّلام عليكم و رحمة الله و بركاته تفضّل أخي الغالي " أبو عبد الرّحمن البغدادي " .. ربّما يكون المطلوب فائق إحتراماتي زيادة خانات الفورمة.rar

السلام عليكم ورحمة الله بعد إذن إستاذنا واخونا الفاضل السيد علي العيدروس ملفك لايحتاج مفتاح فريد مثل رقم عميل او رقم سند لعدم التكرار لانة من الواضح سيتم التكرار تم إضافة بعض التعديلات ارتأيتها ضرورية 2- صفحة تحصيلات العملاء صفحة مدفوعات الموردين وهي تقريبا نفس صفحة تحصيلات العملاء صفحة مصاريف الشركة وهي تختلف بعض الش عن سابقاتها 1- تم إضافة عمود بمسمى الحساب لكي يرحل أي صف الي الحساب المطلوب ممكن تستفيد منة مستقبلا بأن اضفت حسابات أخرى اكثر وهنا إسم الحساب يرتكز علي إسم الصفحة (الشيت Sheet ) مهما بلغت ففي حالة وجود ذلك فقط قم بإضافتها أي ( الصفحة / الصفحات ) إلي القائمة المنسدلة وعند إختيارها فسيتم الترحيل الي هذه الصفحة مهما تعددت الصفحات ومهما تكررت سيأخذ الأول بالأول First In First Out . صفحة الخزينة وهي الأهم والتي يتم الترحيل إليها من عدة صفحات : تم بعض الإضافات عليها وتنسيقها إمكانية الاستفادة من تصفية البيانات وإعطاء بيانات او معلومات او حصر التحصيلات او مدفوعات الموردين او حصر المصاريف وتم عمل تنسيق شرطي في العمود D الجهة بحيث إذا كانت قيمة الخلية (تحصيلات العملاء) يتم تلوين كامل الصف باللون الأزرق فاتح وإذا كانت قيمت الخلية (مدفوعات موردين)يتم تلوينها باللون البنكي واما إذا كانت القيمة (مصاريف الشركة) فبالتلوين الأحمر للخلفية والخط بالاصفر. اما بخصوص الإجماليات مثل هذه : بعد عمل التعديلات فلا ادري في ماذا ستحتاج لها .بإمكانك عمل تصفية (فلترة) في ناحية الجهه ثم التاريخ سيعطيك نفس النتيجة إذا كنت ترغب في خلاف ذلك أي التعديلات الزائدة التي ممكن لا تتوافق مع متطلبات عملك او غير ذلك. وضًح وسيتم التعديل حسب الاستطاعة ملاحظـــــة / اخي احمد أبو ريان استميحك عذرا بأن اضع الموضوع في موضوع جديد لكي يستفاد منة كل من احتاجه بالبحث لان المشاركات لا تظهر بالبحث اخوك في الله / أبو الحسن والحسين لاحظت ان هناك صور لم تظهر فقمت بأخذ كامل الموضوع أعلاه مع الصور واسندتة بلمف وورد مرفق الملف ترحيل من عدة شيتات الى شيت واحد.rar

تفضل SHsabShahry.rar

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

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

السلام عليكم أخى الفاضل جرب هذا الكود Private Sub Worksheet_Change(ByVal Target As Range) Dim cl As Range If Target.Address = [D1].Address Then Cells.Interior.ColorIndex = 0 For Each cl In Range("B3:G7") If cl = Target Then Range(Cells(cl.Row, 2), Cells(cl.Row, 7)).Interior.ColorIndex = 3 Range(Cells(3, cl.Column), Cells(7, cl.Column)).Interior.ColorIndex = 3 End If Next End If End Sub تلوين الصف والعمود.rar

الله يعطيك العافية هذا ما يحتاجه كثير من الإخوة لكن حبذا لو تم التعريف بمعنى كلمة كلمات محجوزة ومشاكل استخدماها حتى يكتمل العقد في هذا الموضوع فالحقيقة أظن أن هذه من الأساسيات التي يجب على كل من يبدأ في صنع برنامج أو إعداده أن يكون ذلك في ذهنه عن أسَامة بن زيد رضي الله عنهما ، قَالَ : قَالَ رسُولُ الله - صلى الله عليه وسلم - : (( مَنْ صُنِعَ إِلَيْهِ مَعْرُوفٌ، فَقَالَ لِفاعِلهِ : جَزَاكَ اللهُ خَيراً ، فَقَدْ أبْلَغَ فِي الثَّنَاءِ )) . رواه الترمذي فجزاك الله خير الجزاء

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

السلام عليكم ورحمة الله وبركاته لهذا المنتدى أفضال كثيره علي شخصياً في تعلم الأمور الكثيره في الأكسيل وأخص بالذكر الأستاذ القدير ( محمد طاهر ) والذي لا يتردد في تقديم المساعده واليوم أقدم لكم هديه متواضعه بها كل ما تعلمته من المنتدى الجميل وأتمنى أن تنال رضاكم وتحقق الفائده . * صمم البرنامج على Microsoft Excel XP * إذا كان خيار الأمان الخاص بالماكرو لديك في الوضع متوسط أو مرتفع فستظهر لك رساله تسئلك قبل التشغيل هل تريد ( تمكين وحدات الماكرو ) أم لا ..؟ بالطبع أختر ( تمكين وحدات ماكرو ) وهذا لكي يتمكن البرنامج من تنفيذ الأوامر المطلوبه منه * إذا أردت أن لا تظهر هذه الرساله لديك مرة أخرى ويتم التشغيل مباشرة أذهب الي ( أدوات - ماكرو - أمان ) وأختار ( منخفض ) فلا تظهر لك الرساله من جديد . * البرنامج يتم التسجيل فيه بشكل شهري وعليك فقط أختيار الشهر والسنه من صفحة الأصناف وسوف تظهر تلقائياً بباقي الصفحات * هناك خيار لمسح كافة البيانات بشكل سهل وبسيط ولكن للمزيد من التأكيد تم وضع صفحه مخصصه لذلك تحتاج فيها لأدخال كلمة السر ثم الضغط على( نعم ) للمسح أو( لا ) للتراجع * كلمة السر للمسح هي ( بسم الله ) * يمكنك أدخال مبلغ ( كحد صرف ) شهري وسوف يقوم البرنامج بحساب الفرق بين المبلغ وبين المصروف ويظهر لك النتيجه في صفحة مستقله * هناك صفحه يظهر بها المصروف الكلي ومصروف كل بند على حده ويمكنك البحث عن الصنف المراد بطريقتين ( الأولى ) بالأسم ... والثانيه ( برقم الصنف ) * لا تقلق من مسح البيانات فالبرنامج محمي لكي لا تتضررالمعادلات والأوامر الهامه به * حجم البرنامج مضغوط ( 447 كيلو بايت ) بعد فك الضغط ( 2.40 ميجابايت ) تفضل بتحميل البرنامج أضغط هنـــــــــا وفقنا الله واياكم لما يحب ويرضى .