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

السّلام عليكم و رحمة الله و بركاته أستاذي الغالي " خالد الشّاعر " عملت تغيير بملف أستاذنا القدير " ياسر خليل أبو البراء " .. بارك الله فيه و جزاه الله خيرًا حاضرًا و غائبًا و زادها بميزان حسناته قمت بتحريك وضعية الجدول لترى الفرق بين الملف الأول و هذا الملف .. لاحظ أنّ العمود الخاص بالتّرقيم هو العمود التّاسع العمود الخاص بالتاكست بوكس 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

السلام عليكم ورحمة الله وبركاته إخواني وأحبابي في الله أحببت أن أضع هذا الموضوع بين أيديكم ليكون مرجعاً لمن أراد معرفة بداية الطريق في التعامل مع محرر الأكواد والبرمجة الموضوع لن يطول فيه الكلام ، سأدع الصور تتحدث وتوصل المعلومة ، حتى تكون المعلومة أثبت للمتعلم حل مشكلة ظهور . رسالة تحذير الخصوصية عند حفظ المصنف كان معكم طائر البطريق من منتدى أوفيسنا العريق دمتم على طاعة الله 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

جرب هذا الملف كشف حساب salim.zip

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

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

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

بالمناسبة .. غدائي اليوم كان بطاطا .. عملت حسابك للغداء لكنّك لم تأتِ مع الأسف .. وها قد وصلتَ الآن ..إذن سأُحيل إليك " الصّحن " عفوًا الملف فائق إحتراماتي

أخي الغالي عبد العزيز البسكري بارك الله فيك وجعله في ميزان حسناتك ما أجمل البساطة (خصوصاً لو كانت مخلوطة بالبطاطا)

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

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

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

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

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

أخي الكريم خالد إليك الملف التالي كنموذج يمكنك التعديل عليه بما يتلائم مع ملفك تقبل تحياتي UserForm TextBox Input YasserKhalil.rar

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

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

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

اخ ابو يوسف طلبك يحتاج وقت للفهم ثم للترتيب ثم للتنفيذ ! لذلك هل يمكن تجزئة الطلب ! بالتوفيق

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

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

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

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

تفضل SHsabShahry.rar

اعزائي عزيزي واخي الاستاذ الخبير ابو عارف وبعد اجمل واطيب تحية اقول دائما ان التفكير منطقيا في المشكلة قبل الحل هو ذات اهمية كبيرة ! فكرت في هل طافت هذه على ميكروسوفت ! فبحثت قليلا في دوال الاكسس فوجدت الدالة التالية : formatnumber واتوقع هي لما نحتاج في التقريب ! وهنا نفذت فكرة كانت تدور في ذهني وكاتالي : Function ramhan_round(xnumber, xrounded) ramhan_round = Format(xnumber, IIf(InStr(1, xnumber, ".") > 0 And xrounded <> 0, "0.", "0") & String(xrounded, "0")) End Function =ramhan_round(125.366, 2) وباستخدام الدالة فورمات ! واخيرا يمكنكم تجربة الدوال : formatcurrency,formatdate,formatpercent لفائدة اكثر ! تحياتي

السّلام عليكم و رحمة الله و بركاته ألف شكر أستاذي القدير " ياسر العربي " على الرّوابط و العناوين الممتازة و المثمرة و المفيدة الدّال على الخير كفاعله .. و أنتَ جمعْتَهما الاثنين معًا .. تدلّ دومًا على فعل الخير و تعمله بارك الله فيك .. جزاك الله خيرًا و زادها بميزان حسناتك وددت مشاركتك بقائمة عناوينك المميّزة بإضافة ملفًا آخرًا بعدّة أسماء للمستخدمين .. كلمات المرور على التّوالي :111-222-333-444-555 فائق إحتراماتي و إعجاباتي أسماء عدة مستخدمين.rar

مثال رقم 3 :- فى المثال رقم 2 كان الشرح على نفس الصوره السابقه فورم فى مرحلة التصميم وصممت عليه Frame والفريم لا يوجد به اى عناصر تحكم تم تصميمها وكان المثال برقم 2 انى اعمل كود عند فتح الفورم يكون هناك عدد 10 صفوف من العناصر كل صف به ليبل وتكست بوكس وكمبوبوكس المثال بتاعنا اليومعايز اعرف ازاى اضيف عناصر تحكم اثناء فتح الفورم من شيت اكسيل وعدد الصفوف بالشيت غير معروف عددها فى زياده او نقصان شاهد الصوره هتعرف اكتر المثال بتاعنا بكل بساطه نفس الكود اللى بالمثال 2 مع تعديلات فنيه بسيطه جدا دا كان الكود اللى بالمثال 2 Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer Top = 5 For i = 1 To 10 With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = "الصقر" & i End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub ايه المطلوب تعديله بالكود لكى يتناسب مع المطلوب بتاعنا رفع الخلايا من الشيت الى الفريم المثال كان على ان عدد الصفوف 10 لذالك استخدمنا الحلقه For next كالتالى For i = 1 To 10 فدلوقتى انا عايز اجيب الخلايا بالشيت رقم 1 النطاق من A2 الى اخر صف هيكون به اخر طالب اذن بداية الحلقه هى اول صف بالجدول وهو الخليه A2 ورقم الصف لها هو 2 اذن الحلقه هتبدأ من رقم 2 الى ؟ الى اخر صف به بيانات فى العمود A اذن لازم احدد اخر صف به بيانات من خلال السطر التالى واحنا شرحناه قبل كدا lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row عملت متغير واسمه Lr وتقدر تسميه اى اسم كيفما شئت وقلت ان المتغير Lr يساوى كتبت اسم الشيت المراد العمل عليه واستخدمت Cells لتحديد عدد الخلايا الممتلئه بالبيانات فى العمود 1 كدا انا عرفت الحلقه من اين تبدأ واين تنتهى ( تبدأ من الصف 2 الى اخر صف به بيانات ) For i = 2 To lr شاهد الكود بعد تعديل الحلقه For Private Sub UserForm_Initialize() Dim Top As Integer Dim i As Integer lr = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row Top = 5 For i = 2 To lr With Me.Frame1.Controls.Add("Forms.Combobox.1", "Combobox" & i) .Left = 20 .Top = Top .Height = 40 .Width = 150 .BackColor = &HFFFFC0 .TextAlign = fmTextAlignCenter .FontSize = 20 .Font.Bold = True Dim a As Variant a = Array("ناجح", "راسب") .List = a .Text = Sheet1.Cells(i, 3).Text End With With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With With Me.Frame1.Controls.Add("Forms.Label.1", "Label" & i) .Left = 340 .Top = Top .Height = 40 .Width = 150 .SpecialEffect = fmSpecialEffectEtched .TextAlign = 2 .FontSize = 24 .Font.Bold = True .BackColor = 8454016 .Caption = Sheet1.Cells(i, 1).Text End With Top = Top + 40 Next Me.Frame1.ScrollHeight = Top End Sub اللى مركز معايا هيلاقى 1- تم تعديل بداية ونهاية الحلقه For 2- فى سطر تم اضافته فى خصائص كل عنصر فى عنصر الكمبوبوكس تم اضافه السطر التالى .Text = Sheet1.Cells(i, 3).Text قيمة الكمبوبوكس هى كتبت اسم الشيت وهو بمثالنا الشيت 1 ثم الخلية المطلوبه Cells عباره عن (رقم العمود, رقم الصف)Cells ( Cells( i , 3 i هنا هى رقم الصف اللى هيتغير كل مره بالحلقه For والعمود هو رقم 3 الخاص بالحاله --------------------------------- فى عنصر التكست بوكستم اضافه السطر التالى .Text = Sheet1.Cells(i, 2).Text نفس الكمبوبوكس ولكن تم تغيير رقم العمود هو 2 الخاص بالدرجه ---------------------------------- فى عنصر الليبل تم اضافه السطر التالى .Caption = Sheet1.Cells(i, 1).Text نفس الكمبوبوكس والتكست بوكس ولكن تم تغيير رقم العمود هو 1 الخاص باسم الطالب ----------------------------------------------------------------------------------------------------------------------- ملحوظه اخيره لمن يريد درجة الاحترافيه فى الكود لما كنا بنعمل خصائص العنصر كان الخاصيه Left & Top & Width& Height لكل عنصر كان بيتم كتابتهم بالشكل التالى كلا منهم على حد فى سطر مختلف على سبيل المثال خصائص التكست بوكس With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Left = 180 .Top = Top .Height = 40 .Width = 150 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With ممكن اكتب الاربع خصائص فى سطر واحد من خلال Move القاعدة الخاصه بــ Move Move Left, Top, Width, Height. ويكون شكل الكود كالتالى بالخصائص With Me.Frame1.Controls.Add("Forms.TextBox.1", "TextBox" & i) .Move 180, Top, 150, 40 .TextAlign = 2 .FontSize = 20 .Font.Bold = True .BackColor = &HC0FFFF .Text = Sheet1.Cells(i, 2).Text End With تم استبدال الاربع صفوف بسطر واحد من خلال Move -------------------------------------------------------------------------------------------------------- جرب الكود بنفسك هتثبت المعلومه اكتر الى لقاء اخر من حلقات سلسلة علمنى كيف اصطاد ان شاء الله هيكون عن كيفية التحكم فى العناصر الموجوده داخل الفريم سوء كانت مصممه اثناء عملية التصميم او تم انشائها بكود انتظرونا تقبلوا تحياتى

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

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

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