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

مقدمة: أولا سوف يتم تقسيم الموضوع إلى عدة أجزاء على موضوعات منفصلة تعريف الإضافة + طريقة تحويل الماكرو إلى إضافة + حمايتها بكلمة سر عمل شيت بسيط يحتوي على 2 زر أحدهم لتثبيت الإضافة والأخر لحذف التثبيت تلقائيا طريقة التعديل على الإضافة عمل تبويب للإضافة لكي تظهر في الإكسل كـ Tab طريقة حماية الإضافة بدون باسورد وجعلها غير قابلة للعرض طريقة عمل تحديث للإضافة بحيث يقوم المستخدم بعمل تحديث للإضافة في حال إصدارلك لإصدار به تحديثات طريقة كسر حماية الإضافة في حال نسيان الباسورد أو كانت غير قابلة للعرض ما هي الإضافة Addin ؟ هي واحدة أو أكثر من التعليمات البرمجية " ماكرو " والتي تقوم بتنفيذ إجراء أو إجراءات على الشيت أو ملف الإكسل كاملاُ يعني الماكرو بتاعي اللي بستخدمه في أي شئ على سبيل المثال تلوين خلايا أو إضافة صفحات إلخ ده بحوله إلى إضافة Addin فيما تكمن أهمية تحويل الماكرو إلى إضافة؟ لنفترض أنني قمت بعمل ماكرو وأردت أن أرسل هذا الماكرو لصديق أو لمجموعة من المستخدمين أو حتى أضعه هنا على المنتدى فمن الطبيعي أن أجد بعض الأشخاص ليس لديهم أي معرفة بمحرر الأكواد ولا يعرفون ماذا تعني الإضافة ولا الماكرو ولكنهم في حاجة للاستفادة من هذا الماكرو وحتى أنا شخصيا هناك بعض الماكروز اللي محتاج إنها تعمل معي على كل ملفات الإكسل الحالية والجديدة وتكون جزء لا يتجزء من برنامج الإكسل الخاص بي فليس من المعقول أن أقوم بإضافة هذا الماكرو لكل ملف إكسل حالي أو جديد فكان من الضروري تحويل هذا الماكرو إلى إضافة. الإضافة بمجرد إضافتها للإكسل فهي تكون بمثابة ملف يحتوي على الماكرو يتم فتحه تلقائيا في كل مرة يتم فيها فتح ملف إكسل وبالتالي يكون جاهز للاستخدام في أي وقت وفي كل ملف إكسل. تحويل الماكرو إلى إضافة كيف يمكن تحويل الماكرو إلى أو مجموعة من الماكروز إلى إضافة Add In؟ الطريقة بسيطة وتتلخص في الأتي: فتح ملف إكسل جديد أو ملف الإكسل الحالي الذي يحتوي على الماكرو التأكد من عمل الماكرو وإخراجه على أكمل وجه ليؤدي الغرض الذي صنع من أجله بطريقة ممتازة يفضل جعل الملف فيه شيت واحد فقط خالي تماما من أي بيانات حماية الماكرو عن طريق وضع كلمة سر لمحرر الأكواد وذلك بالدخول لمحرر الأكواد Alt+F11 ومن ثم الضغط كليك يمين على اسم المشروع لتظهر النافذة التالية لنكتب اسم المشروع " بدون فواصل" ثم وصف المشروع " اسم الإضافة كما نريده أن يظهر " ثم نضع باسورد لحماية الماكرو من العبث 5- أخيرا سنقوم بحفظ ملف الإكسل بعد إغلاق محرر الأكواد ثم نضغط على F12 أو من قائمة File لحفظ الملف باسم Save As 6- نكتب اسم الإضافة بدون فواصل مثال" OfficenaAddin" ليكن شكل الإضافة النهائي كالصورة التالية : لإضافة الـ Addin إلى الإكسل والاستفادة منها وتجربتها يمكنك اتباع الخطوات في الرابط التالي هنــا الجزء الثاني سيتم شرحه في الموضوع القادم بمشية الله وهو عن عمل ملف إكسل صغير يعمل على تثبيت أو حذف الإضافة بضغطة زر ودمتم في رعاية الله

السلام عليكم لكى تجعلها قاصرة على هذا الملف وحده يمكنك ربطها بالاحداث Private Sub Workbook_Activate للبداية بدلا من Workbook_open وانهائها بالحدث Private Sub Workbook_WindowDeactivate بدلا من Workbook_BeforeClose هذا رأيي وجربته عندى ويمكنكم تجربته لتأكيد صحته Private Sub Workbook_Activate() Dim NewControl As CommandBarControl On Error Resume Next Application.CommandBars("Cell").Controls("Show Date And Time").Delete On Error GoTo 0 Set NewControl = Application.CommandBars("Cell").Controls.Add With NewControl .Caption = "Show Date and Time" .OnAction = "Module1.DateAndTime" .BeginGroup = False End With End Sub Private Sub Workbook_WindowDeactivate(ByVal Wn As Window) On Error Resume Next Application.CommandBars("Cell").Controls("Show Date and Time").Delete End Sub

إخواني الكرام في المنتدى الغالي أقدم لكم اليوم موضوع ليس بالجديد ولكنه جد مفيد (جد .. يعني جداً أوك يا جدو) ..أقصد مفيد جداً الموضوع يتمحور ويتمركز حول معرفة الأرقام المفقودة أو الأرقام الناقصة في سلسلة أرقام .. إليكم الكود الأول المؤدي للغرض (هنا يشترط ترتيب الأرقام) ، مع شرح تفصيلي لأسطر الكود لتتمكن من التعديل عليه Sub MissingNumber_NumbersSorted() 'يقوم الكود بإظهار الأرقام الناقصة في تسلسل معين للأرقام ويشترط ترتيب الأرقام '------------------------------------------------------------------------- Dim SH As Worksheet Dim LR As Long Dim Text As String Dim I As Long, X As Long, XX As Long '[Sheet1] تخصيص المتغير ليساوي ورقة العمل المسماة Set SH = Sheets("Sheet1") 'تحديد آخر صف به بيانات في العمود الأول LR = SH.Cells(SH.Rows.Count, 1).End(xlUp).Row 'حلقة تكرارية بداية من الصف الخامس وحتى آخر صف به بيانات في العمود الأول For I = 5 To LR 'يساوي الفرق بين قيمة الخلية التالية وقيمة الخلية الحالية في الصف المحدد [X] المتغير X = Val(SH.Range("A" & I + 1)) - Val(SH.Range("A" & I)) '[X] استخدام الجملة الشرطية لناتج المتغير Select Case X 'إذا كان الفرق بين قيمة الخليتين أكبر من 1 يتم تنفيذ الحلقة التكرارية ما بين السطرين Case Is > 1 'حلقة تكرارية لتخزين الأرقام الناقصة For XX = 2 To X 'يساوي المتغير نفسه مع قيمة الخلية الحالية مضاف إليها قيمة المتغير في الحلقة التكرارية ناقص واحد ثم سطر جديد[Text]المتغير المسمى 'مثال لفهم هذا السطر '------------------- 'توجد القيمة 50012 [A15] توجد القيمة 50009 وفي الخلية [A14] في الخلية 'بما أن الفرق بين الخليتين يساوي 3 إذاً سيتم تنفيذ الحلقة التكرارية 'بداية الحلقة التكرارية 2 حيث أن رقم 2 هو أول رقم أكبر من واحد ، وفي مثالنا نهاية الحلقة التكرارية تساوي 3 'المتغير المفترض تخزين الأرقام الناقصة فيه عبارة عن سلسلة نصية فيتم إضافة النصوص التي سبق استخراجها ثم إضافة النصوص الجديدة 'الأرقام الناقصة تساوي قيمة الخلية الحالية 50009 في المثال مضافاً إليها قيمة الحلقة التكرارية والتي هنا تساوي 2 في بداية الحلقة التكرارية ليصبح الناتج 50011 ثم ناقص واحد لتحصل على أول رقم ناقص ألا وهو 5010 'يساوي 3 لتحصل في النهاية على الرقم التالي الناقص ألا وهو 5011[XX]مع الانتقال في الحلقة التكرارية يصبح المتغير Text = Text & Val(SH.Range("A" & I)) + XX - 1 & vbCrLf Next End Select Next 'رسالة لإظهار الأرقام الناقصة MsgBox Text, vbMsgBoxRtlReading End Sub وإليكم الكود الثاني وهو أقوى في أنه لا يشترط ترتيب الأرقام Sub MissingNumbers_YK_A() 'يقوم الكود باستخراج الأرقام الناقصة من سلسلة من الأرقام ولا يشترط ترتيب الأرقام '---------------------------------------------------------------------------- Dim InputRange As Range, OutputRange As Range, ValueFound As Range Dim LowerVal As Single, UpperVal As Single, Count_I As Single, Count_J As Single Dim NumRows As Long, NumColumns As Long Dim Horizontal As Boolean On Error GoTo ErrorHandler 'النطاق الذي يحتوي سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) LowerVal = WorksheetFunction.Min(InputRange) UpperVal = WorksheetFunction.Max(InputRange) Horizontal = False 'بداية النطاق الذي سيتم استخراج النتائج به Set OutputRange = Range("E2") NumRows = OutputRange.Rows.Count NumColumns = OutputRange.Columns.Count Application.ScreenUpdating = False If NumRows < NumColumns Then Horizontal = True NumRows = 1 Else NumColumns = 1 End If Count_J = 1 For Count_I = LowerVal To UpperVal Set ValueFound = InputRange.Find(Count_I, LookIn:=xlValues, LookAt:=xlWhole) If ValueFound Is Nothing Then If Horizontal Then OutputRange.Cells(NumRows, Count_J).Value = Count_I Count_J = Count_J + 1 Else OutputRange.Cells(Count_J, NumColumns).Value = Count_I Count_J = Count_J + 1 End If End If Next Count_I Application.ScreenUpdating = True Exit Sub ErrorHandler: End Sub كما تمت إضافة حل بمعادلات الصفيف لتؤدي نفس الغرض وإليكم أيضاً كود رائع للأخ الحبيب سليم حاصبيا مع شرح للأسطر ولا يشترط الترتيب للأرقام أيضاً Sub MissingNumbers_SALIM() 'يقوم الكود باستخراج الأرقام الناقصة في سلسلة أرقام ولا يشترط الترتيب '------------------------------------------------------------------ 'تعريف المتغيرات Dim Dico, D Dim C As Range, Rng As Range Dim B As Long, I As Long Dim MinVal As Double, MaxVal As Double 'النطاق المراد استخراج الأرقام الناقصة منه Set Rng = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'سطر لايجاد أقل قيمة رقمية في النطاق MinVal = Application.WorksheetFunction.Min(Rng) 'سطر لايجاد أكبر قيمة رقمية في النطاق MaxVal = Application.WorksheetFunction.Max(Rng) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("G2", Range("G2").End(xlDown)).ClearContents 'إنشاء متغير من النوع كائن لتخزين الأرقام الناقصة به Set Dico = CreateObject("Scripting.Dictionary") 'حلقة تكرارية لكل الأرقام المسلسلة For I = 1 To (MaxVal - MinVal + 1) 'تعتمد هذه الأسطر على إضافة الرقم الناقص إلى الكائن المخصص لذلك If Application.WorksheetFunction.CountIf(Rng, MinVal + I - 1) = Then If Not Dico.Exists(MinVal + I - 1) Then Dico.Add (MinVal + I - 1), (MinVal + I - 1) End If Next I 'رقم صف البداية للنتائج في العمود السابع B = 2 'حلقة تكرارية لوضع القيم التي تم تخزينها في النطاق المحدد For Each D In Dico.items Range("G" & B) = D B = B + 1 Next D End Sub وعشان عيون أحبابي إليكم الكود الرابع وهو أفضل الأكواد من حيث أنه لا يشترط ترتيب الأرقام وأسطر الكود سهلة الفهم وسهلة التعامل معها Sub MissingNumbers_YK_B() 'يقوم الكود باستخراج الأرقام الناقصة في تسلسل للأرقام ولا يشترط الترتيب '------------------------------------------------------------------- 'تعريف المتغيرات Dim InputRange As Range Dim X As Long, lRow As Long 'تعيين النطاق الذي سيحتوي على سلسلة الأرقام المراد استخراج الأرقام الناقصة منها Set InputRange = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row) 'مسح محتويات النطاق الذي سيتم استخراج النتائج به Range("I2:I1000").ClearContents 'حلقة تكرارية من أقل قيمة بالنطاق لأكبر قيمة بالنطاق For X = WorksheetFunction.Min(InputRange) To WorksheetFunction.Max(InputRange) 'استخدام دالة البحث فإذا كانت القيمة المراد البحث عنها غير موجودة يعطي خطأ 'وبناءً على الخطأ يتم تنفيذ السطر التالي If IsError(Application.Match(X, InputRange, )) Then '[I] الرقم 2 هو رقم صف البداية في العمود '[I] يتم وضع الرقم الناقص في الخلية في الصف المحدد في العمود Cells(lRow + 2, "I") = X 'زيادة المتغير بمقدار واحد للانتقال لصف جديد لإدراج الأرقام الناقصة lRow = lRow + 1 End If Next X End Sub أترككم مع الملف المرفق ...للاستفادة بشكل عملي بالكود كان معكم أخوكم ياسر خليل أبو البراء YK (الموضوع مهدى للأخ الحبيب والأستاذ الكبير أسامة البراوي OB ومهدى للأخ الفاضل نايف - م) حمل الملف من هنا تقبلوا تحياتي

أخى أبو زهرة جرب هذا الكود Sub ChangingPaperSize() Application.ScreenUpdating = False Dim Cl As Range blnAns = Application.InputBox("أدخل 3 للطباعة على ورق 3" & vbCr & "أدخل 4 للطباعة على ورق 4", "اختر نوع ورق الطباعة", , , , , , 4) If blnAns = 3 Then For Each Cl In Range("e11:e35") If Cl.Value = "" Or Cl.Value = 0 Then Cl.EntireRow.Hidden = True End If With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 2 .FitToPagesTall = 1 .PaperSize = xlPaperA3 On Error Resume Next End With Next Cl ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False Else For Each Cl In Range("e11:e35") If Cl.Value = "" Or Cl.Value = 0 Then Cl.EntireRow.Hidden = True End If With ActiveSheet.PageSetup .Zoom = False .FitToPagesWide = 2 .FitToPagesTall = 1 .PaperSize = xlPaperA4 On Error Resume Next End With Next Cl ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True, IgnorePrintAreas:=False End If Rows("11:36").Select Selection.EntireRow.Hidden = False Range("A1").Select Application.ScreenUpdating = True End Sub

السلام عليكم أخي أبو البراء الغالي: كلنا معك ... فأنت نبراس هذا المنتدى الكريم..وكلكم خير وبركة إن شاء الله تعالى.

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

بعد إذن أخي الكريم محيي الدين كان يجب إرفاق الملف وليس صورة مع ذكر بعض النتائج المتوقعة عموماً حسب ما فهمت بقدر ما فهمت (وأنا على أدي في موضوع الفهم ده فالناس تعذرني لقلة فهمي) Sum Digits In Numbers YasserKhalil.rar

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

بسم الله الرحمن الرحيم موضوع محاسبى بنكهة الاكسيل تحليل نقطة التعادل Break Even Point Analysis مفيد للمحاسبين والمديرن ورؤساء المبيعات وللمهتمين باتخاذ القرارات الماليه ------------------------------------------------------------------------------------------------- بصفتك المحاسب للشركة طلب منك صاحب الشركة تحديد المبيعات التى ينبغى على الشركة ان تبيعها حتى لاتحقق خسائر او تحقق رقم معين من الارباح وليكن 10000 جنيه . فماذا بامكانك ان تفعل؟ الجزء الاول التمهيدى من تحليل التعادل يخلوا من التفاصيل النظريه هذا الجزء بداية عمليه فقط تحليل التعادل.rar

السلام عليكم ورحمة الله وبركاته وبعد موضوع اليوم من وجهة نظرى المحدودة فكرة لذيذة ونادرة على ما أعتقد الفكرة هى كما يبدو من العنوان ازاى نحذف محتوى الشيت مع استثناء مدى معين وفى المرفق الجميل اللى هتحمله أتحداك لو ما قلتش الله . تحياتى Delete all data on sheet except certain range .rar

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

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

جزيت خير الجزاء أخي الحبيب محمد الريفي فأنت مرجع المنتدى فيما يخص المحاسبة تقبل تحياتي

السلام عليكم بعد اذن كل استاذتى جزاهم الله خيرا هذه معادله بسيطه CSE كنت قد اعددتها ارجو ان تفيد بالغرض { =SUM(IFERROR(VALUE(MID(A1;ROW($1:$100);1));0))} http://www.officena.net/ib/index.php?showtopic=61891وهذا رابط الموضوع

أعانكم الله ..المهم إحنا اطمنا عليك روح كمل غطس لو لسه مخلصتش

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

ننتظر رأي الأخ علي الشيخ وأسامة البراوي بخصوص هذه النقطة حيث أنهما أعلم مني تقبل تحياتي أخي إبراهيم

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

تعجز كلماتى عن الشكر لك أستاذى لك كل التحيات جعله الله فى ميزان حسناتك

data/بيانات text to columns/نصوص إلى أعمدة

أخي الحبيب أبو سليمان (رفقاً بنا ........ أين الالتزام بالتوجيهات) يرجى البحث أولاً عن طلبك بالمنتدى ثم إذا لم تجد اطرح موضوع جديد الغريب في الأمر أنني قدمت ثلاثة حلول متتالية لطلبك في موضوعك على هذا الرابط من هنا في المشاركة رقم 25 و 26 و 27 (إنت شوية كدا وهتجنني بطلبك لنفس الطلبات !!!!!!!!!!!!!!!!!!!!!!!)

يمكنك اضافة السطر ده فى داخل الكود او اضافته فى كود منفصل مع تغيير اسم الشيت (sheet1 ) الى اسم الشيت الذى ترغب فى تنظيفة وتعديل المدى ("a6:ak100") حسب الحاجة Sub Clear_Colour() Sheets("sheet1").Range("a6:ak100").Interior.ColorIndex = 0 End Sub

=A1&"."&B1&"."&C1

الله يكرمك يا استاذ ياسر بالمنتدى من هم اقوى منى فى التعامل مع الفورم والاغلب انهم ايضا اكثر موهبة فى الشرح والتفصيل مثل الاستاذ عبدالله قشير والعديد من الأساتذة الخبراء ومثال على اعمالهم ما نقوم الان بشرحه وهو موجود فى http://www.officena.net/ib/index.php?showtopic=53104 وسوف احاول عمل شرح لبعض النماذج ومكونات الفورم قدر ما امكننى ان شاء الله على احد اعمالهم الموجودة بالمنتدى جزءا بجزء

=A1&B1&C1

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

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

و عليكم السلام و رحمة الله و بركاته يرجى أخى الكريم إرفاق ملف للعمل عليه مع توضيح النتيجة المرجوة ، لمزيد من التفاصيل يرجى مراجعة موضوع التوجيهات من هذا الرابط http://www.officena.net/ib/index.php?showtopic=60147 شكرا .

وهذه تحسين لفكرة اخي الفنان جعفر ! وحسب فهمه ! يعني لو خطأ مالنا شغل ! الصق جملة الاستعلام التالية كمصدر للاستعلام TRANSFORM Sum(Table1.ammount) AS Sumمنammount SELECT Year([dates]) AS السنة FROM Table1 GROUP BY Year([dates]) PIVOT IIf(Month([dates]) Between 1 And 6,"1-6","7-12"); بالتوفيق

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

أتمنى من الله أن تكونوا جميعا في تمام الصحة والعافية وإن شاء الله موضوع اليوم يكون جديد وخفيف وسهل التطبيق ومفيد للبعض على الأقل الفكرة : هي جعل اليوزر فورم شفاف مع إمكانية التحكم في درجة الشفافية بما يتناسب مع إحتياجاتنا والفائدة من هذا هو التنوع في شكل اليوزرفورم وأيضا يمكن أن يكون مفيدا بأنك تستطيع رؤية المحتوى خلف اليوزفورم بدون أن تضطر إلى تحريكه خاصة في اليوزرفوم ذو الأبعاد الكبيرة. طريقة التطبيق: بعد تصميم اليوزفورم أو أي يوزر فورم حالي يتم الدخول إلى الكود الخاص باليوزرفوم كليك يمين على الفورم ثم View Code ثم نقوم بلصق الكود التالي في أعلى كود اليوزفورم قبل أي أكواد أخرى Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _ (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" _ (ByVal hWnd As Long, ByVal nIndex As Long) 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 SetLayeredWindowAttributes Lib "user32" _ (ByVal hWnd As Long, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const GWL_EXSTYLE = (-20) Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2& Public hWnd As Long ثانيا في Userform Initialize يتم نسخ وضع الكود التالي هكذا: Private Sub UserForm_Initialize() Dim bytOpacity As Byte bytOpacity = 190 ' يمكنك تغيير درجة الشفافية بالتغيير ما بين القيم 0 إلى 255' hWnd = FindWindow("ThunderDFrame", Me.Caption) Call SetWindowLong(Me.hWnd, GWL_EXSTYLE, GetWindowLong(Me.hWnd, GWL_EXSTYLE) Or WS_EX_LAYERED) Call SetLayeredWindowAttributes(Me.hWnd, 0, bytOpacity, LWA_ALPHA) End Sub ودمتم في رعاية الله يوزرفورم شفاف.rar

أخي الكريم ياسر نوح مشكور على كلماتك الطيبة وشعورك النبيل جرب التعديل في الكود بهذا الشكل Sub M_ELSHRIEF() Dim Answer As Long, lCount As Long Dim iStart As Integer, iEnd As Integer Answer = MsgBox("هل تود الطباعة بعد المعاينة ؟", vbYesNo + vbQuestion, "طباعة") On Error Resume Next If Answer = vbYes Then iStart = InputBox("أدخل بداية الحلقة التكرارية من 1 إلى 12", "YasserKhalil", 1) iEnd = InputBox("أدخل نهاية الحلقة التكرارية من 1 إلى 12", "YasserKhalil", 12) '[L2] حلقة تكرارية من 1 إلى 12 ليتم وضع قيم الحلقة في الخلية For lCount = iStart To iEnd 'بدء التعامل مع ورقة العمل النشطة With ActiveSheet .Range("L2").Value = lCount 'هذا السطر لمعاينة ورقة العمل النشطة .PrintPreview 'طباعة ورقة العمل النشطة نسخة واحدة '.PrintOut Copies:=1 End With Next lCount End If End Sub تقبل تحياتي

السلام عليكم الاخ ابو سليمان من واقع كلامك فإن الملفات فى المجلد الاول تحدث بصفة يومية اى يتم ادخال البيانات اليها بصفة يومية مثلا تكون البيانات فيه حتى يوم 26/5/201005 اما المجلد 2 فاخر بيانات فيه هى حتى يوم 25/5/2015 هل تريد 1- مقارنة المحتوى الجديد بالمجلد الاول واضافة بيانات اليوم الجديد الي ملفات المجلد الثانى دون التأثير على المعادلات ( اضاقة اليوم 91، 92 ، 2- ام مسح البيانات الموجودة بالكامل فى الملفات الموجودة بالمجلد 2 واستبدالها بما هو جديد بدون التأثير على اى معادلات قد تكون موجودة

أخي الكريم ياسر نوح وجب عليك التوضيح من البداية كما فعلت في المشاركة السابقة التوضيح والتفصيل للطلب يسهل الوصول لحل إذ أن الفكرة كيف لي أن أساعدك وأنا لا أفهم المطلوب ، ففهم المطلوب عليه عامل 90% من الوصول للحل ، حتى لو كان المطلوب صعب .. المهم إليك الكود التالي (طبعاً كما فهمت من الصورة ورقة العمل المطلوب الكود بها هي "توصيف رياضة") Sub M_ELSHRIEF() Dim Answer As Long, lCount As Long Answer = MsgBox("هل تود الطباعة بعد المعاينة ؟", vbYesNo + vbQuestion, "طباعة") If Answer = vbYes Then '[L2] حلقة تكرارية من 1 إلى 12 ليتم وضع قيم الحلقة في الخلية For lCount = 1 To 12 'بدء التعامل مع ورقة العمل النشطة With ActiveSheet .Range("L2").Value = lCount 'هذا السطر لمعاينة ورقة العمل النشطة '.PrintPreview 'طباعة ورقة العمل النشطة نسخة واحدة .PrintOut Copies:=1 End With Next lCount End If End Sub تقبل تحياتي

اصبر واسمعني لو سمحت: مرة واحد عربي تزوج زوجة جديدة على زوجته الاولى, وكانت الاولى لما تمر على الجديدة تقول: نقل فؤادك حيث شئت من الهوى...مالحب الا للحبيب الاولِ كم منزل في الارض يألفه الفتى...وحنينه ابدا لأول منزلِ فترد الثانية وتقول: وما يستوي الثوبان ثوب به البلى...وثوب بايدي البائعين جديدُ والخيار لك ياسيدي أن تبقى على زوجتك الاولى او الثانية. عفوا اقصد اوفسك الاول او اوفسك الثاني.. مملة الحكاية صح!!!!

انا اصوت للاستمرار على وضعك

انا اصوت ل 2013 فهو يجب ما كان قبله :power:

وعليكم السلام انا اصوت لـ 2010 ، مع ان 2013 موجود. جعفر

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

اخي نايف اليك ما تريد بواسطة الكود,فليكن ذلك (هو انا يهمني -على رأي الفنان عادل امام) انظر الى الصفحة Mydata serie non reguliee (vba).rar

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

الاخوه الكرام وجدت فى احد المنتديات هذه المعادله التى تقوم بتفقيط المبالغ فاردت ان تعم الفائده على الجميع تفقيط.rar

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

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