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

اساتذتى الافاضل فى هذا الصرح العلمى كثيرا ما نواجه عناء وتعب الاختيار من القائمه للكمبوبوكس خاصه لو كان القائمة تحتوى على 2000 صف مثلا فيكون الاختيار من القائمة امر شاق ومرهق واستمراراً فى البحث عن ابتكار شئ جديد يفيدنا جميعا أقدم لكم اليوم كود فى حدث تغيير الكمبوبوكس لحل هذه المشكله وتوفر علينا عناء البحث بمجرد كتابة حرف ( عربى او انجلش) او رقم او علامه مثل ( & * / # وغيرها ) ستجد الكمبوبوكس تم فلترة القائمه طبقا لما تريد البحث عنه أقدمه لكم صدقه جاريه على روح المغفور له بأذن الله استاذى / عماد الدين الحسامى لا تنسوا الفقيد من صالح دعائكم اسال الله تعالى ان يتغمده بواسع رحمته تقبلوا تحياتى اخوكم وتلميذكم / حسام كمبوبوكس طبقا للبحث - الصقر.zip

السلام عليكم ورحمة الله وبركاته أخى أبو يوسف جرب هذا الكود حساب عدد التكرار لكل مكتب في جميع الاوراق و أبدى ملاحظاتك Option Explicit Sub CopyToNewSheet() ' by Mokhtar Hussien ' 25/11/2015 Dim SH As Worksheet Dim P As Long Dim Rng As Range Dim Data, ColFound Dim Obj As Object Application.ScreenUpdating = False Application.DisplayAlerts = False '----------------------------------------------------------------- Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = "التجميعى" '----------------------------------------------------------------- For Each SH In ThisWorkbook.Sheets If IsError(Application.Match(SH.Name, Array("Master", "التجميعى"), 0)) Then SH.Range("M2").CurrentRegion.Offset(1).Copy With Sheets("التجميعى") .Activate .Range("B1:C1") = Array("مكتب التربية", "العدد") .Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).PasteSpecial Paste:=xlPasteAll With .Range("B1").CurrentRegion .Range("A1:B1").Interior.Color = vbYellow .Borders.Weight = xlThin .BorderAround Weight:=xlThick .Columns.AutoFit End With End With End If Next '----------------------------------------------------------------- With Sheets("التجميعى") ColFound = Application.Match("*مكتب التربية*", .Rows(1), 0) If IsNumeric(ColFound) Then .Range("G2:H2") = Array("الاحصاء النهائى لمكاتب التربية", "الجملة") Set Rng = .Range(.Cells(2, ColFound), .Cells(.Cells(Rows.Count, ColFound).End(xlUp).Row, ColFound)) Set Obj = CreateObject("scripting.dictionary") Data = Rng For P = 1 To UBound(Data) Obj(Data(P, 1) & "") = "" Next .Range("G3:G1000").ClearContents .Range("G3").Resize(Obj.Count, 1) = Application.Transpose(Obj.keys) '----------------------------------------------------------------- With .Range("H3:H" & .Cells(Rows.Count, "G").End(xlUp).Row) .Formula = "=SUMPRODUCT( (R2C2:R1000C2 =RC[-1]) * R2C3:R1000C3 )*2" .Value = .Value End With '----------------------------------------------------------------- With .Range("G2").CurrentRegion .Borders.Weight = xlThin .BorderAround Weight:=xlThick .Columns.AutoFit .Range("A1:B1").Interior.Color = vbYellow End With '----------------------------------------------------------------- .Columns("A:F").Delete Shift:=xlToLeft '----------------------------------------------------------------- End If End With '----------------------------------------------------------------- Sheets("Master").Activate Application.CutCopyMode = False Application.ScreenUpdating = True Application.DisplayAlerts = False End Sub أخى و أستاذى ياسر راجع هذا الكود و ان كان يحتاج لتحسينات فتفضل مشكورا تحياتى Collect Data From Multiple CSV Workbooks Yasser Mokhtar final.rar

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

أخى وأستاذى الغالى بارك الله فيك . اكتشفت خطأ فى المعادلة SUMPRODUCT و تم التصحيح أخى أبو يوسف المرفق التالى لحساب عدد التكرار لكل مكتب في جميع الاوراق هذا المرفق به كودين يتم استدعائهما بزر واحد اذا كنت تريد استدعاء كل كود على حده كما طلبت فى مشاركتك الأخيرة يمكنك التعديل بسهولة كالتالى السطر التالى فى الكود الاول يحذف Call CopyToNewSheet أضف شكلا تلقائيا أو زر و اربطه بالكود الثانى وأى ملاحظات أخرى فأهلا و سهلا بها فلا تخجل تحياتى لك ولأخى وأستاذى أبا البراء Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V 4.rar

أخي الحبيب الغالي مختار بارك الله فيك .. قمت بتعديل بسيط على كودك حيث حذفت الجزء الخاص بتنسيق النطاقات المنسوخة إذا لا داعي لها حيث أنك في نهاية المطاف تقوم بحذف الأعمدة إليكم المرفق الأخير حيث تم الجمع بين جميع الأكواد Collect Data From Multiple CSV Workbooks YasserKhalilMokhtar V3.rar

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

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

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

المشروع الكبير: شرح برنامج المخزون و الفواتيرالشامل الاصدار الثالث هذا البرنامج هو النسخة الثالثة من برنامج المخزون و الفواتير الشامل وهو من الممكن اعتباره اكثر من برنامج فى برنامج واحد يصلح لكافة اغراض المبيعات و المشتريات وذمم عملاء وموردين مع ميزانية عامه توضح الربح و الخساره يمتاز البرنامج بكثرة التقارير وسهولة الحصول عليها فى اى وقت البرنامج به الكثير من الاضافات عن الاصدارات السابفة البرنامج مليئ بافكار جديده فى طريقة ادخال الاصناف داخل الفواتير و استدعائها و التعديل عليها ربما لم تشاهدها من قبل البرنامج بواجهة تطبيقية كاملة مما يسهل من استخدامه ويسرع من ادائة ويحافظ على ثباته البرنامج يعمل على نسختي اوفيس 2007 و 2010 وان كنت انا افضل النسخة الأخيرة من حيث السرعة ** اليوم وانا على وشك انتهاء مرحلة تجربة هذاالاصدار احببت ان اقدم لكم الشرح الوافى لهذا البرنامج البرنامج يحتوى على الكثير و الكثير من الاختصارات التي تساعدك في انجاز مهامك بسرعه عالية وهى افكار جديده على الاكسيل ** تم تصميم البرنامج بمواصفات خاصه وهو فى الاصل برنامج تجارى ولكنى اقدمه هنا للمنتدى وللأخوة الاعضاء بصورة مجانية بغرض التعلم او استخدامهم الشخصىعلى شرط ان لن يقوم اى شخص بتقديم هذا البرنامج الى اى جهه او شركة بغرض الربح. فحقوق ملكيتة محفوظة لى و الله الشاهد على ذلك البرنامج سوف يتم نزوله مفتوح المصدر فليس غرضى هو الاحتكار ولكنى اريد هذا العمل خالصا لوجه الله تعالى لكى يستفيد ويتعلم الجميع Ø يمكن التعديل في البرنامج على حسب ظروفي ومدى انشغالي اذا كانت تغييرات غير جوهريه Ø اليوم اقدم لكم شرح وافى للبرنامج لطلب كثير من الاعضاء و ايضا لضرورة التعرف على بعض النقاط الهامه داخل البرنامج كما يمكنك الحصول على ملف تنفيذى به شرح كامل للبرنامج حجم الملف 7 ميجابايت يمكنك مراسلتى على الايميل لطلب الشرح amroomo@gmail.com # فى الاسبوع القادم بمشيئة الله سوف اقوم بتنزيل البرنامج على المنتدى و عندما تنتهى فترة تجربة البرنامج ليكون كاملا و الكمال لله وحده سبحانه وتعالى ...... لن اطيل عليكم فلنبدأ على بركة الله بالشرح وهو عباره عن صور تشرح كافة تفاصيل البرنامج

لدي قاعدة بيانات خاصة بمتابعة الطلاب فيها جدول بالفصول وجدول بالطلاب وجدول بالمخالفات أريد عند وقوع الطالب في مخالفة ما في تاريخ ما ( مثلا الغياب بغير عذر ) يتم حسم درجتين من الدرجة الكلية وعند تكرار المخالفة يتكرر الحسم ... وعند الوقوع في مخالفة ثانية ( مثلا عدم حضور حصة دراسية )يتم حسم درجة واحدة وعند التكرار يتكرر الحسم ... طبعا الدرجة الكلية خمسين درجة يتم حسم كل المخالفات منها أريدتقريريظهر لي : اسم الطالب وكم تكررت كل مخالفة مرات والدرجة المتبقة من 50 بعد حسم المخالفات .. وفقكم الله وبارك فيكم متابعة.rar

السلام عليكم ورحمة الله وبركاته إخوانى وأحبائى الأعزاء أعضاء وأساتذة عالم العلم والمعرفة بأوفيسينا تحية طيبة وبعد كنت قد طرحت موضوع من قبل عبارة عن Rank يسحب داتا معينة من Report وقام السيد الفاضل الأستاذ القدير / العيدروس بعمل لى كود أكثر من روعة وقمت بطرح هذا الكود للتعديل عليه مرة أخرى لسحبها بطريقة ما وتفضل أيضا أستاذى ومعلمى القدير / العيدروس بتعديلة اليوم أطرح نفس الكود لتعديل جزء بسيط به خاص بخانة معينة داخل Rank مظللة باللون الأصفر لتعطى النتيجة الموضحة داخل اللون الأصفر وهى عبارة عن جميع الأصناف المباعة للمندوب حتى لو مكررة أى كاملة مرفق الملف وبه الكود وأيضا الكود موضح الرجاء المساعدة ولسيادتكم خالص الشكر والتقدير مع وافر التحية Private Function Ali(Ln As Long, Vl, Bl As String, Bln As Boolean) Dim Shet As Worksheet Dim Do_Ali Dim Ar() As Variant Dim iCnt& Dim X, A On Error Resume Next Set Shet = Sheets("Report") Set Do_Ali = CreateObject("Scripting.Dictionary") With Application .ScreenUpdating = False .EnableEvents = True DoEvents With Shet Lr = .Cells(.Rows.Count, 2).End(xlUp).Row Ar = .Range("A2:F" & Lr).Value: A = Bl For R = LBound(Ar, 1) To UBound(Ar, 1) If Ar(R, 3) = A Then If Not Bln Then If Vl = 3 Then ZZ = Ar(R, 2): ZZZ = Ar(R - 1, 2) If ZZZ <> ZZ Then X = X + 1 End If End If If Vl = 4 Then X = X + Ar(R, 6) End If End If If Do_Ali.exists(Ar(R, Ln)) Then Do_Ali.Item(Ar(R, Ln)) = Do_Ali.Item(Ar(R, Ln)) + 1 Else Do_Ali.Add Ar(R, Ln), 1 End If End If Next Ali = IIf(Vl = 1, Do_Ali.Count, X) End With .ScreenUpdating = True .EnableEvents = False End With Erase Ar Set Do_Ali = Nothing Set Shet = Nothing End Function Sub Ali_Count() Dim Sh As Worksheet Dim Sht As Worksheet Dim R, Rr, Cll, Lrr Set Sh = Sheets("Rank") Set Sht = Sheets("Report") With Sh Lrr = Sht.Cells(Rows.Count, 2).End(xlUp).Row Sht.Sort.SortFields.Add Key:=Sht.Range("A2:A" & Lrr), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal With Sht.Sort .SetRange Sht.Range("A1:F" & Lrr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Rr = 10: Cll = 13 For R = Rr To Cll If .Cells(R, 2) <> "" Then .Cells(R, 4) = Ali(1, 4, .Cells(R, 2), False) .Cells(R, 9) = Ali(1, 3, .Cells(R, 2), False) .Cells(R, 14) = Ali(4, 1, .Cells(R, 2), True) .Cells(R, 19) = Ali(1, 1, .Cells(R, 2), True) End If Next End With MsgBox "Greetings with Engineer / Yasser Fathi Al-Banna " End Sub Rank End.rar

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

اذهب الى الدالة التاليه في الكود Private Function Ch_Month(Mn As String) Dim Mm& Dim Tn$, X$ For Mm = 1 To 12 Tn = MonthName(Mm) If Tn = Trim(Mn) Then Mm = Mm - 1 X = MonthName(Mm) Exit For End If Next If Mm Then Ch_Month = X End Function واستبدلها بهذا التعديل Private Function Ch_Month(Mn As String) Dim Im, Tn, X Dim Ar On Error GoTo 1 Ar = Array("يناير", "فبراير", "مارس", "أبريل", "مايو", "يونيو", "يوليو", "أغسطس", "سبتمبر", "أكتوبر", "نوفمبر", "ديسمبر") For Im = 0 To UBound(Ar) Tn = Ar(Im) If Tn = Trim(Mn) Then Im = Im - 1: X = Ar(Im): Exit For Next Im Ch_Month = X 1 End Function اضن السبب تسمية الاشهر لديك ربما تكون بالفرنسية في الـ VBA

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

وعليكم السلام.. في الويندوز

أخي الغالي مختار يوجد بالفعل خطأ في أثناء تنفيذ الكود مع الملفات التي بها صفين فقط من البيانات فقمت بتعديل الكود بحيث يزود كمان صف على الموجود كما قمت بإدراج الإحصاء في العمودين Y و Z بدلاً من العمودين M و N لأنني لاحظت أن بعض الملفات بها بيانات في هذين العمودين للأسف وأكرر للأسف تحدث مشاكل حين يكون المرفق غير معبر عن الملفات الأصلية .. لأننا اشتغلنا على مجموعة ملفات لها نفس المواصفات أما عند إرفاق ملفات جديدة لها مواصفات جديدة فكان لابد من التغيير ليتلائم الكود مع الوضع القائم عموماً إليك المرفق التالي فيه المصنف الرئيسي ومرفق ملفات CSV الأخير المسمى girl (قم بتغيير اسمه ..ولن يؤثر في شيء) Collect Data From Multiple CSV Workbooks Mokhtar YasserKhalil V4.rar

السّلام عليكم و رحمة الله و بركاته أخي الكريم " محمّد عبد السّلام " .. قمت بعمل ملفين للشّريط المتحرّك بملفين مختلفيْن .. قمْ باختيار اللّون الذي يناسب ذوقك .. و إذا كان الاتّجاه خاطئًا و ليس الذي تريده .. أخبرني لتغييره فائق إحتراماتي fatorrr.rar

بارك الله فيك استاذ ابو محمد وفي جميع الاخوة المشاركين استفسار اخر في الاكسس كنت احتفظ بجميع المرفقات خارج القاعدة واقوم بربطها بالسجل حتي اتغلب علي موضوع حجم القاعدة في الاكسس الان وقد تم حل موضوع الحجم بالانتقال الي ال sql server فهل اظل علي نفس الطريقة ام هناك طريقة اخري مثل ان احتفظ بالمرفقات داخل القاعدة نفسها ملحوظة المرفقات عبارة عن ملفات pdf.tiff.word.excel... وهي كثيرة جدا

مع التحية برنامج فك الرقم السري لاكسيل.rar

ياعم ناصر التنسيقات شغاله زي الفل انا عملت زر فقط لعمل التنسيقات علي جميع الورق هي بتطبق التنسيقات عل جميع الشيتات بناء علي الورقة 2 فالكود دا هيفرق مع الشيت الاخير بس لانه مش نفس تقسيمة الشيتات كلها نحاول نعمله تظبيطه لوحده بس جرب كدا الاول ترحيل البيانات لأعمدة محددة بدون صفوف فارغة لورقة عمل جديدة +7777.rar اخي الغالي ابو البراء انا معايا الكتالوج بتاع ناصر لو تحب تطلع عليه انا بفهم ناصر من غير ما يقول حاجه يحط المرفق وانا اشتغله فيه علي طول

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

استبدل الكود عندك بها الكود وسوف ترى النتيجة Sub زر_1() lh = Cells(Rows.Count, "H").End(3).Row lc = Cells(Rows.Count, "c").End(3).Row Range("H5:H" & lh).Clear Range("c5:c" & lc).SpecialCells(xlCellTypeConstants, 1).Copy Range("H5") End Sub

استاذى الحبيب ابويوسف شاكر لك مرورك العطر وكلماتك الطيبه تقبل تحياتى

أخي الحبيب ياسر العربي نستحمله عشان خاطرك إنت بس .. أخي الكريم ناصر المصري إليك السطر التالي كنموذج لتغيير عرض الأعمدة المثال على العمود الأول Columns("A:A").ColumnWidth = 11 أرجو أن يكون المطلوب يا ريت ترجع للتوجيهات في الموضوعات المثبتة في المنتدى لمعرفة مزيد من التفاصيل حول كيفية طرح موضوع بشكل مناسب (ولا تطارد أكثر من عصفور فتطير العصافير جميعها)

الف شكر لك استاذي اجمد الفلاحجي واستاذي ابو محمد2 علي مجهودكم جعله الله في ميزان حسناتكم وزادكم الله من علمه

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

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

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

السلام عليكم تحيه طيبه لجميع الاخوه الاعضاء فيما يخص سؤال الاخ سلامه sql server لا يتعامل مع ملف نوع attachment كما في الاكسس ولكن ملف الصور يجب ان يكون من نوع OLE في ال sql server فاما ان تعدل النوع في الاكسس الى OLE Object او تضيف الحقل ومن نوع image في sql server بعد رفع الجداول الى sql server قبل اجراء عملية الربط فيما يخص سؤال الاخ حسين تقريبا نفس تنصيب ال2012 والجميع يحتاج وضع باسوورد الى حساب المستخدمين تحية الى الاخ احمد الفلاحجي لتفاعله واغناء الموضوع مشكورا بالتوفيق

اخى حسين تم رفعه على درايف لان المساحه غير مقبوله كتاب شرح تثبيت sql server 2008 خطوة خطوة (شرح مفصل بالصور) بالتوفيق

بعد اذن الاستاذ محمد سلامه لي سؤال كيفية تنصيب sql server 2008 ويندوز 7 بايت 32 وما المطلوب عمله قبل التنصيب وهل يلزم عمل مستخدمين علي الويندوز لو امكن شرح وافي لوتكرمتم

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

السلام عليكم ======================= تم إضافة عمود لحالة الأقساط للعملاء ======================= وزر لطباعة التقرير في فورمة التقرير الكلي ======================= المرفق الاولى شرح طريقة العمل مع الاضافة والمرفق الاخر الملف تحياتي شرح_1.rar الاقساط_Ali_12.rar

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

السلام عليكم ورحمة الله وبركاته تحياتى وتقديرى لجميع أحبائى أعضاء وأساتذة هذا الصرح العلمى الهائل أدخل المعادلة الأتية بأى خلية داخل الإكسيل وشاهد النتيجة بنفسك تحياتى =CHAR(225)&CHAR(199)&CHAR(32)&CHAR(197)&CHAR(225)&CHAR(229)&CHAR(32)&CHAR(197)&CHAR(225)&CHAR(199)&CHAR(32)&CHAR(199)&CHAR(225)&CHAR(225)&CHAR(229)&CHAR(32)&CHAR(227)&CHAR(205)&CHAR(227)&CHAR(207)&CHAR(32)&CHAR(209)&CHAR(211)&CHAR(230)&CHAR(225)&CHAR(32)&CHAR(199)&CHAR(225)&CHAR(225)&CHAR(229)

اهداء مصطفى كمال معلم اول مدرسة امل الزقازيق رابط تدريبات الرضيات للصم http://gulf-up.com/do.php?id=27682 رابط تدريبات اللغة الانجليزية للصم http://gulf-up.com/do.php?id=27686 رابط تدريبات اللغة العربية للصم http://gulf-up.com/do.php?id=27691

أخي الكريم أحمد جرب المعادلة التالية في الخلية E2 =IF(D2>=2110,316.5,ROUND(D2*15%,2)) إذا صادفتك مشكلة قم باستبدال الفاصلة الموجودة في المعادلة بفاصلة منقوطة تقبل تحياتي

تفضل اخي وائل الملف مع الكود المناسب Print Set_up.zip

ارجو رفع الملف مره اخري اخي سليم

وعليكم السلام . تفضل ، المرفق في هذا الرابط يقوم بفتح النموذج عدة مرات ، بدون ان يعمل نسخ جديدة: http://allenbrowne.com/ser-35.html جعفر

وبما ان الاستعلام الذي استعملته هنا هو استعلام جدولي ، فاليك نصيحة كلفتني غاليا حتى عرفتها: http://www.officena.net/ib/topic/61853-فلتر-التاريخ-نصف-سنوى/?do=findComment&comment=401042 جعفر

جرب هذا الملف القائمة المنسدلةتستجيب لاي تعديل او زيادة في البيانات قائمه منسدله مطاطة.zip

جرب هذا لكود (انه يقوم بطباعة كل 25 سطر على صفحة واحدة مع العنوان الرئيسي) يمكنك تغيير العدد 25 من خلا ل الكود بتغيير مقدار العامل deg في السطر رقم 10 للمزيد انظر الى المرفق Sub my_setup() Application.ScreenUpdating = False k = 0 ActiveSheet.PageSetup.PrintArea = "" lr1 = Cells(Rows.Count, 1).End(3).Row On Error Resume Next ActiveSheet.PageSetup.PrintTitleRows = "$1:$1" Range("a1:a" & lr1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete deg = 25 'you can change this number lr = Cells(Rows.Count, 1).End(3).Row For i = 0 To lr Step deg If lr - i < deg Then Exit For ActiveWindow.View = xlPageBreakPreview Set ActiveSheet.HPageBreaks(k + 1).Location = Range("A" & i + deg + 2) k = k + 1 Next m = "$A$1:$E$" & lr1 & """" ActiveSheet.PageSetup.PrintArea = m ActiveSheet.DisplayPageBreaks = False ActiveWindow.View = xlNormalView Application.ScreenUpdating = True End Sub My_print_Set_Up.zip

السلام عليكم _____.rar

السلام عليكم اخي BU3MMAR اخي هذه هي بالفعل نفس الفكرة فالزر الاول ياخذ اسماء الشيتات و يضعها في العمود الاول A و الزر الثاني اذا وجد اسم او رقم في الخلية الموجودة في العمود الثاني و المقابله لاسم الشيت لو وجد بها رقم او اسم (وطبعا هناك مجموعة ممنوعات ك / او بمعني اصح كل مالا يقبله الاكسل في تسمية الشيتات) فهذا معناه انك تريد اعادة تسمية هذا الشيت بالذي موجود في هذه الخلية و ان تركت فارغة لن يغير اسم الشيت ارفقت لك ملف فيديو بشرح العمل مع الملف مرة اخري مع اضافة on error resume next للتماشي مع اي خطأ مع انني قمت بتجربة الملف اكثر من مره و ليس هناك اي خطأ يذكر تحياتي BU3MMAR2.rar

السلام عليكم تفضل المرفق معمول بالمعادلات ____________.rar

بينما كنت أتجول بين ملفاتي القديمة استوقفني برنامج قارئ الأفكار والذي كنت قد قمت بعمله منذ 7 سنوات تقريباً والذي هو تقليد أعمى لبرنامج قارئ الأفكار للأستاذ علي السعيد بسبب إعجابي الشديد للأفكار التي به ولدراستي في تلك الأيام للأرقام الثنائية. فأول من فكرت بهم عند رؤيتي للبرنامج هم أنتم يا أعضاء منتداي الغالي لكي تستفيدوا من تلك التجربة. لقد قمت بإرفاق ملفين: الأول قارئ الأفكار2 Reader الذي قمت بتقليده الثاني Reader الأصلي لا تنسونا من صالح دعائكم وبالتوفيق للجميع ____________2_Reader.rar READER.rar

السلام عليكم ارجو ان ينال اعجابكم خالص تحياتي Add_sheet_with_name_with_hyper.rar

السلام عليكم اخي AHH بارك الله فيك ليه الاعتذار اخي لك حرية الرد و حرية كسب الاجر ليس هناك حرج اطلاقا شمر ساعدك واكسب الاجر في هذه الليالي المباركة فخير الناس انفعهم للناس