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

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

فنون وأساليب التنبؤ باستخدام الاكسيل نعرض أساليب التنبؤ بالدوال وأدوات تحليل البيانات الموجودة في برنامج ميكروسوفت اكسيل ثم نتناول الطرق الرياضية والاحصائية في كيفية حساب الدالة. للتأكيد على المزايا التي يوفرها الاكسيل والدقة العالية التي يحسب بها النتائج ******************************************** الفئات المستهدفة: المدراء الماليين رؤساء الحسابات المحاسبين مديري المبيعات المهتمين بدراسات الجدوى العاملون في مجال التخطيط المالي والموازنات التقديرية -------------------------------------------------------------------- دورة مجانية 100% يستضيفها جروب تدريب وتأهيل المحاسبين بالإسكندرية برعاية المحاسب القانوني الأستاذ احمد وفا. وسيتم تحديد موعد كل محاضره والاعلان عنها وسيكون الحضور اون لاين للانضمام في الدورة https://www.facebook.com/events/509996679169161/ ------------------------------------------------------ فيديو تعليمي بداخل الفيديو كتيب pdf+ ملفات اكسيل تطبيقية ارجو من الجميع المشاركة فهذه الدورة مجانية 100% ولا تنسونا بصالح دعاؤكم ملفات الاكسيل التطبيقية.rar

السلام عليكم ورحمة الله أخواني وأساتذتي الكرام لطالما أبدعتمونا بإنجازتكم وافكاركم الجميلة والمتميزة في هذا الموقع والصرح العملاق فأحببت أن أشارك معكم هذا الكود الجميل والمتميز في أطفاء وإعادة تشغيل الكمبيوتر من ملف أكسل وذلك بعد قمت ببعض التعديلات الخفيفة للملف لكي يصبح بشكل أجمل ومرغوب للجميع الملف يعمل على أنظمة ويندوز XP و7 و8 و8.1 وكافة نسخ أوفيس سواء كانت بيئة 32 بت أو 64 بت أترككم لتجربة الملف وإعطاء أفكار جديدة حول الموضوع تقبلو تحياتي ومروري إطفاء وإعادة تشغيل الكمبيوتر.rar

استاذى الحبيب ابويوسف انا عايز اعترفلك باعتراف صغير انا شفت الموضوع ده وهو نازل كان بالشاشه الرئيسيه just now بس بصراحه خفت اكتب مشاركة لانها كانت مش هتعجبك وهتزعل منى وانت ربى يعلم ان زعلك عندى غالى لكن بما ان الاخ الحبيب أبوالبراء قال كل اللى كان بخاطرى فقلت اتكلم بقى واتجرأ فى مثل شعبى عندنا بيقول ("القفه " أم ودنين يشيلوها اتنين) يعنى ناس مسئوله عن جانب وناس مسئوله عن جانب اخر يعنى "وتعاونو " وحضرتك كنت بتعمل ده فى موضوع تدوين الاعمال الحديثه بالمنتدى هو راح فين ؟ لية وقف ؟ اتمنى ياغالى متزعلش منى وتتقبل الكلام بصدر رحب انا مشكلتى مش بعرف اعبر زيك أنت ربنا اعطاك حلاوة اللسان أما انا فمتزعلش من اى لفظ مكتوب غير مقصود تقبل تحياتى

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

اخي ووالدي واستاذي اتمنى من الله دوام الصحة لك ولكل احبابك مجرد مرورك فقط اخي الغالي علي موضوعنا فهو لشرف عظيم لنا واتمنى من الله ان يفرج عنك ما انت فيه من ضيق وارجو منك الا تحرمنا من كلماتك الجميلة التي هي بدورها قادرة علي رفع الروح المعنوية لنا جميعا وعشان محدش يقول اني بخيل اادي الصور في فورم لللي محتاجه الموضوع دا بكود بسيط تقدر تضيف كل لمساتك عليه الكود يوضع في حدث تغيير الكومبوكس Private Sub ComboBox1_Change() On Error Resume Next TextBox1.Text = ComboBox1.Value MyPath = ThisWorkbook.Path & "\data\" FullImagePath = MyPath + TextBox1.Value Image1.Picture = LoadPicture(FullImagePath) End Sub image & userform.rar

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

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

خسارة ..جيت متأخر يا عربي خدها الصقر وطار

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

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

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

السلام عليكم منذ تعرفي على vba excel احببت التعامل مع اليوزر فورم والأكواد وكل ما يتعلق بهم بعد طرحي لموضوع برنامج تتبع وتسيير شؤن اللأليات والموضفين المصمم على الإكسل احببت ان اقدم لكم اليوم جزأ من برنامج صممته على يوزر فورم بعدما ترجمته الى اللغة العربية لأن النسخة الاصلية صممتها باللغة الفرنسية أروج أن تستفيدو منه الباسورد للبرنامج ولمحرر الأكواد هو 123 برنامج تسيير شؤن الموضفين.rar

طريقة عمل شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل !! خطوة خطوة السلام عليكم اساتذة المنتدي وخبراؤه الكبار الاخوة الافاضل اعلم ان هذه الموضوعات قد قتلت بحثا وطلبا واجابة من الاعضاء وهناك امثلة كثيرة للاساتذة الافاضل الكبار والذي لايصل علمنا او ما لدينا كله الي ذرة واحدة من علمهم ولكني اردت ان اجعل المواضيع الاساسية في عمل اي برنامج في متناول الجميع بطريقة بسيطة وسهله اكثر ما يكون من خلال هذه السلسلة ( اعانني الله علي اكمالها كما ينبغي ) وقصدت ان يكون الموضوع بعنوان واضح ليستفيد منه الجميع عند البحث وسأقدم الشرح بطريقة الفيديو والاكسيل والورد احياناً (((( الدرس الاول )))) شاشة ( فورم ) لادخال بيانات والقيام بتسجيل وترحيل هذه البيانات الي صفحة الاكسيل و الاستعلام من خلالها عن طريق نفس الفورم والتعديل ايضا في البيانات في حالة ما اردنا التعديل في بيان قد سبق ادخاله وطبعاً والاكيد كله من علمكم اساتذتي الكرام الاجلاء وفي الدرس القادم سنتعرف علي بعض الاكواد المعاونة لشاشة الادخال او بمعني ادق اكواد نحتاجها مع شاشة الادخال مثل (تنسيق التكست بوكس ، الترقيم التلقائي في تكست معين ، تنسيق التاريخ في التكست بوكس .... ) واي استفسار .... في الخدمة دائما ... واي شئ غير واضح في الشرح علي استعداد تام لشرحه مرة اخري ومرات اخري واليكم ايضا في المرفقات : 1- ملف اكسيل به الاكواد والشرح هذه المرة داخل الكود ( تم شرح الكود سطر سطر بطريقة وافية وبسيطة جدا داخل الكود نفسه ) 2- عدد ( 3 ) ملف فيديو يشرح طريقة التصميم واضافة الاكواد وكذلك مشاهدة النتيجة جزاكم الله خيرا اساتذتنا اكسيل ..طريقة عمل شاشة ادخال 1.rar فيديو 1 .. طريقة عمل شاشة ادخال 1.rar الملف الفيديو الثاني والثالث في المشاركة التالية حيث لم يمكنني اضافتهم هنا

السلام عليكم برنامج مخازن مجرب ومباع في الكويت لكبرى الشركات والمؤسسات به كل ما يتمناه اي مسئول مخزن سهل الاستخدام قوي النتائج ملحوظة : كلمة المرور في البرنامج هي 1234 ملحوظة : لاضافة اي معلومة داخل اي صندوق فقط النقر مرتين بالماوس علي الصندوق لفتح شاشة الادخال الخاصة به وبعدها تجد ما اضفته موجود بالصندوق ملحوظة : البرنامج مصمم علي اكسيس 97 وانا في الطريق لعمل نسخة لباقي اصدارات الاكسيس ارجو ان يفيدكم ولا تنسونا بالدعاء اخوكم علي عبد الحميد - الكويت Str.zip

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

بسم الله الرحمن الرحيم الاخوة والاخوات فى هذا الصرح العظيم أقدم لكم اليوم الاصدار الثالث من برنامج EMA يشمل جميع الامور المحاسبيه هذه النسخه نسخه تجريبيه يرجى من الاخوة المحاسبين والمهتمين بالامور المحاسبية التجربه والتقييم للوصول الى الافضل ان شاء الله بنزل الشرح عن كيفية الاستخدام والتعامل مع البرنامج اى سؤال أو استفسار لا تترد وأنا تحت امركم كلمة المرور - الدعم الفني الباسورد - 123 تفضل نسختك EMA.zip

حلول ممتازة اساتذتى الكرام .... جزاكم الله خيراً واسمحوا لى بتقديم احد الحلول الاخرى إثراءاً للموضوع يوم المراقبة =INDEX(ورقة2!D7:D11;SMALL(IF(ورقة2!E7:G11=L8;ROW(ورقة2!E7:G11)-ROW(ورقة2!E7)+1);1)) مكان المراقبة =INDEX(ورقة2!E6:G6;SMALL(IF(ورقة2!E7:G11=L8;COLUMN(ورقة2!E7:G11)-COLUMN(ورقة2!E7)+1);1)) هذه معادلات صفيف بعد كتابتها يتم الضغط على CTRL+SHIFT+ENTER وليس ENTER فقط واليك المرفق ايام المراقبة.rar

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

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

مشكوووورررر اخي ابو سليمان لمرورك الكريم اثابك الله وانار طريقك بالعلم النافع بس فيه سؤال بيطرح نفسه ??مين ابو عماار

السلام عليكم تفضلوا الكود للتحكم قي درجة شفافية القورم - نسخة 64Bit ملف للتحميل : https://app.box.com/s/m96bzgd2efpp5gr9isl96y4n2xav6rm7 1- كود في موديول الفورم : Option Explicit Private WithEvents oAppEvents As Application Public bytScrollBarVal As Byte 'Userform events Private Sub UserForm_Activate() Call UpdateFormPicture(Me) End Sub Private Sub UserForm_Initialize() Set oAppEvents = Application Call init(Me) End Sub Private Sub UserForm_Layout() Call UpdateFormPicture(Me) End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) Set oAppEvents = Nothing Call CleanUp End Sub Private Sub ScrollBar1_Change() Me.bytScrollBarVal = 255 - ScrollBar1.Value Call UpdateFormPicture(Me) End Sub Private Sub ScrollBar1_Scroll() Me.bytScrollBarVal = 255 - ScrollBar1.Value Call UpdateFormPicture(Me) End Sub Private Sub CommandButton1_Click() Unload Me End Sub 'Application events Private Sub oAppEvents_SheetActivate(ByVal Sh As Object) Call UpdateFormPicture(Me) End Sub Private Sub oAppEvents_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range) Call UpdateFormPicture(Me) End Sub Private Sub oAppEvents_WindowActivate(ByVal Wb As Workbook, ByVal Wn As Window) Call UpdateFormPicture(Me) DoEvents End Sub Private Sub oAppEvents_WorkbookActivate(ByVal Wb As Workbook) Call UpdateFormPicture(Me) DoEvents End Sub 2- كود في موديول عادي : Option Explicit Private Type POINTAPI x As Long y As Long End Type Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Private Type GUID Data1 As Long Data2 As Integer Data3 As Integer Data4(0 To 7) As Byte End Type Private Type PICTDESC Size As Long Type As Long hPic As LongPtr hPal As Long End Type Private Type BLENDFUNCTION BlendOp As Byte BlendFlags As Byte SourceConstantAlpha As Byte AlphaFormat As Byte End Type Private Type LOGBRUSH lbStyle As Long lbColor As Long lbHatch As Long End Type Private Declare PtrSafe Function ClientToScreen Lib "user32" (ByVal hWnd As LongPtr, lpPoint As POINTAPI) As Long Private Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As LongPtr) As LongPtr Private Declare PtrSafe Function ReleaseDC Lib "user32" (ByVal hWnd As LongPtr, ByVal hDC As LongPtr) As Long Private Declare PtrSafe Function BitBlt Lib "gdi32" (ByVal hDestDC As LongPtr, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As LongPtr, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long Private Declare PtrSafe Function AlphaBlend Lib "msimg32.dll" (ByVal hDC As LongPtr, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal hDC As LongPtr, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal lInt As Long, ByVal BLENDFUNCT As Long) As Long Private Declare PtrSafe Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As LongPtr) Private Declare PtrSafe Function CreateCompatibleDC Lib "gdi32" (ByVal hDC As LongPtr) As LongPtr Private Declare PtrSafe Function CreateCompatibleBitmap Lib "gdi32" (ByVal hDC As LongPtr, ByVal nWidth As Long, ByVal nHeight As Long) As LongPtr Private Declare PtrSafe Function DeleteObject Lib "gdi32" (ByVal hObject As LongPtr) As Long Private Declare PtrSafe Function SelectObject Lib "gdi32.dll" (ByVal hDC As LongPtr, ByVal hObject As LongPtr) As Long Private Declare PtrSafe Function DeleteDC Lib "gdi32" (ByVal hDC As LongPtr) As Long Private Declare PtrSafe Function GetWindowRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long Private Declare PtrSafe Function GetClientRect Lib "user32" (ByVal hWnd As LongPtr, lpRect As RECT) As Long Private Declare PtrSafe Function OleCreatePictureIndirect Lib "oleAut32.dll" (PicDesc As PICTDESC, RefIID As GUID, ByVal fPictureOwnsHandle As LongPtr, IPic As IPicture) As LongPtr Private Declare PtrSafe Function FillRect Lib "user32" (ByVal hDC As LongPtr, lpRect As RECT, ByVal hBrush As LongPtr) As Long Private Declare PtrSafe Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As LongPtr Private Declare PtrSafe Function SetBkMode Lib "gdi32" (ByVal hDC As LongPtr, ByVal nBkMode As Long) As Long Private Declare PtrSafe Function TranslateColor Lib "oleAut32.dll" Alias "OleTranslateColor" (ByVal clr As OLE_COLOR, ByVal palet As Long, Col As Long) As Long Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr Private Declare PtrSafe Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long) As Long Private Declare PtrSafe Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long Private Declare PtrSafe Function SetLayeredWindowAttributes Lib "user32" (ByVal hWnd As LongPtr, ByVal crey As Byte, ByVal bAlpha As Byte, ByVal dwFlags As Long) As Long Private Const PICTYPE_BITMAP = &H1 Private Const SRCCOPY = &HCC0020 Private Const AC_SRC_OVER = &H0 Private Const OPAQUE = &H2 Private Const GWL_EXSTYLE = (-20) ' Private Const WS_EX_LAYERED = &H80000 Private Const LWA_ALPHA = &H2 Private hInitialDCMemory As LongPtr Private frmHwnd As LongPtr Private frmDc As LongPtr Public Sub init(ByVal oFrm As Object) Dim LB As LOGBRUSH Dim Realcolor As Long Dim tRed As OLE_COLOR, tGreen As OLE_COLOR, tBlue As OLE_COLOR Dim hBmp As LongPtr Dim tRect As RECT Dim hBrush As LongPtr 'setup form controls With oFrm .ScrollBar1.Min = 0 .ScrollBar1.Max = 255 .ScrollBar1.SmallChange = 3 .ScrollBar1.Value = .ScrollBar1.Max .ScrollBar1.BackColor = vbCyan .Label1.Font.Bold = True .Label1.BackStyle = fmBackStyleTransparent .CommandButton1.Caption = "Close" .CommandButton1.Font.Bold = True .Caption = "Adjustable Transparent UserForm -- (Client Area)" End With 'retrieve the form hwnd and DC frmHwnd = FindWindow("ThunderDFrame", oFrm.Caption) frmDc = GetDC(frmHwnd) 'convert system color to RGB TranslateColor oFrm.BackColor, 0, Realcolor tRed = Val(CStr(Realcolor And &HFF&)) tGreen = Val(CStr((Realcolor And &HFF00&) / 2 ^ 8)) tBlue = Val(CStr((Realcolor And &HFF0000) / 2 ^ 16)) LB.lbColor = RGB(tRed, tGreen, tBlue) 'create a memory DC and store the initial form backColor in it for later blending hBrush = CreateBrushIndirect(LB) GetWindowRect frmHwnd, tRect hInitialDCMemory = CreateCompatibleDC(frmDc) With tRect hBmp = CreateCompatibleBitmap(frmDc, .Right - .Left, .Bottom - .Top) End With Call SelectObject(hInitialDCMemory, hBmp) SetBkMode hInitialDCMemory, OPAQUE FillRect hInitialDCMemory, tRect, hBrush DeleteObject hBrush DeleteObject hBmp ReleaseDC frmHwnd, frmDc End Sub Public Sub UpdateFormPicture(ByVal oFrm As Object) Dim BF As BLENDFUNCTION Dim lBF As Long Dim IID_IDispatch As GUID Dim uPicinfo As PICTDESC Dim IPic As IPicture Dim tPt As POINTAPI Dim hBmp As LongPtr Dim scrDc As LongPtr Dim tRect As RECT Dim hDCMemory As LongPtr Static frmClientWid As Long Static frmClientHgt As Long Static l As Long oFrm.Label1.Caption = "Transparency : " & (100 * oFrm.ScrollBar1.Value \ 255) & "%" 'brievely make the form fully transparent in order to capture the screen area underneath the form SetWindowLong frmHwnd, GWL_EXSTYLE, GetWindowLong(frmHwnd, GWL_EXSTYLE) Or WS_EX_LAYERED If l Mod 4 = 0 Then SetLayeredWindowAttributes frmHwnd, 0, 0, LWA_ALPHA End If l = l + 1 scrDc = GetDC(0) hDCMemory = CreateCompatibleDC(scrDc) hBmp = CreateCompatibleBitmap(scrDc, frmClientWid, frmClientHgt) 'retrieve the form's client dimensions GetClientRect frmHwnd, tRect With tRect frmClientWid = .Right - .Left frmClientHgt = .Bottom - .Top End With 'create a memory DC to hold the screen area underneath the form Call SelectObject(hDCMemory, hBmp) tPt.x = tRect.Left: tPt.y = tRect.Top ClientToScreen frmHwnd, tPt Call BitBlt(hDCMemory, 0, 0, frmClientWid, frmClientHgt, scrDc, tPt.x, tPt.y, SRCCOPY) 'make the form opaque again SetLayeredWindowAttributes frmHwnd, 0, 255, LWA_ALPHA 'blend the form's initial backcolor with the screen image underneath the form With BF .BlendOp = AC_SRC_OVER .BlendFlags = 0 .SourceConstantAlpha = oFrm.bytScrollBarVal .AlphaFormat = 0 End With CopyMemory lBF, BF, 4 AlphaBlend hDCMemory, 0, 0, frmClientWid, frmClientHgt, hInitialDCMemory, 0, 0, frmClientWid, frmClientHgt, lBF 'Set the Form's Picture property to the resulting blended memory Bitmap With IID_IDispatch .Data1 = &H20400 .Data4(0) = &HC0 .Data4(7) = &H46 End With With uPicinfo .Size = Len(uPicinfo) ' .Type = PICTYPE_BITMAP .hPic = hBmp .hPal = 0 End With OleCreatePictureIndirect uPicinfo, IID_IDispatch, True, IPic Set oFrm.Picture = IPic DeleteDC hDCMemory ReleaseDC 0, scrDc oFrm.Repaint End Sub Public Sub CleanUp() DeleteDC hInitialDCMemory End Sub

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

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

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

وادي ياعم الكود وعليه بوسة كمان وكمان لو الصورة مش موجود ليها اسم في الشيت هيقولك مفيش صورة ولو موجود ليها اسم في الشيت بس مش موجودة في المسار بردو هيقولك انها مش موجودة في المسار ولو طلع الكود فيه غلط ياسر هيقولك فين عشان يصلحه image & userform.rar

السلام عليكم اللأخ سمير لقد عدلت وأضفت بعض الأشياء حسب فهمي وأرجو أني وفقت للمطلوب وهذا هو المرفق: sc_2.rar

أخي الكريم مصفطى ضع الكود التالي في موديول Public Coll As New Collection Public Function RefreshCollection() As Collection Dim collDummy As New Collection, ArrIn, ArrHead, I As Long, J As Long, Str1 As String, V Set Coll = Nothing With Sheet1.Range("C46").CurrentRegion ArrIn = .Value ArrHead = .Resize(1).Offset(-44).Value For J = 3 To UBound(ArrIn, 2) Step 2 For I = 2 To UBound(ArrIn, 1) If Len(ArrIn(I, J)) Then On Error Resume Next Str1 = CStr(ArrIn(I, J)) V = Coll(Str1) If Err.Number <> 0 Then Set collDummy = Nothing Coll.Add Key:=Str1, Item:=collDummy End If On Error GoTo 0 Coll(Str1).Add Array(ArrIn(I, J), ArrIn(I, J - 1), ArrHead(1, J - 1)) End If Next I Next J End With Set RefreshCollection = Coll End Function Public Function GetData(Param As String) Dim ArrOut, I As Long, V1, V2 If Coll.Count = 0 Then Set Coll = RefreshCollection() On Error Resume Next Set V1 = Coll(Param) If Err.Number = 0 Then ReDim ArrOut(1 To V1.Count, 1 To 2) For Each V2 In V1 I = I + 1 ArrOut(I, 1) = V2(1) ArrOut(I, 2) = V2(2) Next V2 GetData = ArrOut End If On Error GoTo 0 End Function ثم أدرج موديول جديد وضع فيه الكود التالي Sub UpdateAll() Dim I As Long, J As Long Application.ScreenUpdating = False For I = 8 To 80 Step 3 Sheet2.Cells(4, I).Value = J + 1 J = J + 1 Next I Application.ScreenUpdating = True End Sub قم بإنشاء زر أو أي شكل في ورقة العمل "حصص المعلمين" ثم كليك يمين على الزر واختر Assign Macro ثم اختر الماكرو المسمى UpdateAll لربط الزر بهذا الإجراء الفرعي وأخيراً ضع الكود التالي في حدث ورقة العمل المسماة "حصص المعلمين" ..من خلال كليك يمين على اسم ورقة العمل ثم اختر View Code والصق الكود التالي Private Sub Worksheet_Activate() Set Coll = RefreshCollection() End Sub Private Sub Worksheet_Change(ByVal Target As Range) Dim Arr, strAddress As String, lCol As Long If Not Intersect(Target, Union(Range("H4"), Range("K4"), Range("N4"), Range("Q4"), Range("T4"), Range("W4"), Range("Z4"), Range("AC4"), Range("AF4"), Range("AI4"), Range("AL4"), Range("AO4"), Range("AR4"), Range("AU4"), Range("AX4"), Range("BA4"), Range("BD4"), Range("BG4"), Range("BJ4"), Range("BM4"), Range("BP4"), Range("BS4"), Range("BV4"), Range("BY4"), Range("CB4"))) Is Nothing Then Application.EnableEvents = False strAddress = Target.Address(0, 0) lCol = Range(strAddress).Column Range(Cells(6, lCol), Cells(1000, lCol - 1)).ClearContents Arr = GetData(Target.Value) If IsArray(Arr) Then Cells(6, lCol - 1).Resize(UBound(Arr, 1), UBound(Arr, 2)).Value = Arr Application.EnableEvents = True End If End Sub أرجو أن تكون الخطوات واضحة إذا تعذر عليك الأمر سأقوم بإرفاق ملف

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

الله ينور

السّلام عليكم و رحمة الله و بركاته أخي الكريم ياسر العربي .. فكّرت أهديلك إيهْ في حفلة تخرّجك .. لمْ أجدْ سوى هذه .. أرجو أن تكون هديّتي قد المقام أخوك / عبد العزيز البسكري ياسر العربي.rar

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

اخي العزيز السلام عليكم اي حقل يمثل عدد ايام الغياب للمادة

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

أخي الكريم مصطفى أين المرفق الجديد بعد تعديله للعمل عليه؟

أخي الكريم ياسر إنت متأكد إن الكلام الجامد دا أنا قلته ..أنا معرفش أقول الكلام دا يا عم عموماً كلام جميل وكلام معقول مقدرش أقول حاجة عنه !! تقبل تحياتي

كل الشكر والتقدير لكم اعزائي سأتفرغ واحاول ان اطبقها علي الفورم وبعدين سؤال محير هي ترقية الملازم بتيجي بعد صف ظابط علي طول

ايه الحلاوه دى يا محترف ايوه كدا طلع كنــــــــــــــــــــــوزك (اوعى تقراها بدون حرف النون ) جزاكم الله خيرا لمشاركتنا اعمالك القيمة تقبل تحياتى

افكار حلوة والله من الاستاذين علي وابا خليل الاستاذ ابا خليل حسن فكرة الاستاذ علي وبوجود مفتاح الحل وهو الطرح ثم الزيادة ! تحسين رائع ! هنا اخينا حربي العنزي ذكر : فهل الفاصلة فاصلة عشرية ؟ لانه ذكر النتاج 819 ! ولم يذكر 819000 وهو الناتج في الحلين من قبل الاساتذه اذا اعتبرنا الرقم بدون فاصلة ! واذا بفاصلة يظهر رقما اخر ! وهذا مجرد تحويل فكرة الاستاذين الى تعبير في مربع نص : =IIf([Summuny] Mod 250>0;([Summuny]-([Summuny] Mod 250))+250;[Summuny]) تحياتي

السلام عليكم جميعا ورحمته الله وبركاته أخى الفاضل الاستاذ // رضا راغب أهلا وسهلا بك أخى الكريم بين إخوانك المتميزين خلقا وعلما وأدبا وبعد إذن اخى الحبيب // ياسر خليل " أبو البراء " وإثراءا للموضوع إليك هذا الكود وبإذن الله تعالى ستجد حلا للموضوع جزاكم الله خيرا وبارك فيكم Private Const cRunWhat = "Tarhil_Values" Private RunWhen As Double, Arr() As Range, CurIndex As Long Public Sub StartTimer() Dim A As Areas, I As Long If RunWhen > 0 Then MsgBox "The Process Is Already Running" Exit Sub End If Set A = Sheets("Sheet1").Columns("A").SpecialCells(2, 1).Areas ReDim Arr(1 To A.Count) For I = 1 To A.Count Set Arr(I) = A(I).CurrentRegion Next I CurIndex = 0 RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub Public Sub StopTimer() On Error Resume Next Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=False RunWhen = -1 MsgBox "Transferring Data Will Be Turned Off" End Sub Private Sub Tarhil_Values() CurIndex = CurIndex + 1 If CurIndex > UBound(Arr) Then StopTimer Exit Sub End If Arr(CurIndex).Copy Sheets("Sheet2").Cells(Arr(CurIndex).Row, "C") Application.CutCopyMode = False RunWhen = Now + TimeSerial(0, 0, 10) Application.OnTime earliesttime:=RunWhen, procedure:=cRunWhat, Schedule:=True End Sub

السم عليكم استاذ واائل اسف على التاخير..... فلم ياخرني في الرد الا اني اعتبرت الموضوع غير مهم فقط وليس تجهل وهذا دليل علي عدم التجاهل عند شعوري باهتمامك لمعرفة ما حصل معي . الكود الذي ارفقته لم يفلح لكن توصلت لحل هو تغيير كلمة OR الي AND .... ولكن هذا الكود لاياتي بنتيجة محكمة لانه عند الفورمات الجهاز يتغير هذا الرقم ......... فااصبحت ابحث عن طريقة اخرى كود اخر يخرج لي رقم الهارد الذي لايتغير مع الفورمات Private Sub Workbook_Open() 'If Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C:").SerialNumber) <> "سريل الجاهز الاول" And Hex(CreateObject("Scripting.FileSystemObject").Drives.Item("C:").SerialNumber) <> "سريل الجهاز الثاني" Then 'MsgBox "Attention ! Ce programme est spécial pour M : tahar1983 ", vbCritical, "Violation des droits du programme" 'ThisWorkbook.Close savechanges = True 'End If End Sub

شكرا لك بارك الله فيك

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

أخي الكريم سعد يرجى تغيير اسم الظهور بشكل مناسب ليظهر اللقب مع الاسم إليك الكود التالي يوضع في حدث ورقة العمل المسماة Quires ..بمجرد الاختيار من الخلية H9 Private Sub Worksheet_Change(ByVal Target As Range) Dim LR As Long, LRQ As Long, Cell As Range If Target.Cells.CountLarge > 1 Then Exit Sub If Not Intersect(Target, Range("H9")) Is Nothing Then Application.ScreenUpdating = False With Sheets("Quires").Range("B15:G1000") .Offset(1).ClearContents .Borders.LineStyle = xlNone End With With Sheet1 .Rows(1).AutoFilter .Rows(1).AutoFilter 10, "=" & Sheets("Quires").Range("H9") LR = .Range("A" & .Rows.Count).End(xlUp).Row If LR > 1 Then Union(.Range("D2:F" & LR), .Range("I2:I" & LR), .Range("K2:K" & LR)).Copy Sheets("Quires").Range("C" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues End If .Rows(1).AutoFilter End With With Sheets("Quires") LRQ = .Range("C" & .Rows.Count).End(xlUp).Row If LRQ > 15 Then For Each Cell In .Range("B16:B" & LRQ) Cell = Cell.Row - 15 Next Cell End If With .Range("B15").CurrentRegion .Borders.Weight = xlThin .BorderAround Weight:=xlThick End With .Range("H9").Select End With Application.ScreenUpdating = True End If End Sub وإليك الملف المرفق تقبل تحياتي Filter Copy Specific Data YasserKhalil.rar

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

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

أخي وحبيبي في الله أبو يوسف لا أعرف من هو (لوزتين بدخل) .. ولكن يبدو أن عقلي أيضاً مثل عقله بالنسبة لمشكلة الانترنت أقترح استخدام الإضافة المرفقة في المشاركة ... قم بتحميل الإضافة المسماة Mozilla Archiver Format ثم فك الضغط عنها لتجد الملف المسمى Mozilla Archiver Format.xpi من خلال الفايرفوكس روح على قايمة Tools ثم اختر الأمر Add-ons ستجد علامة تشبه الترس وبجانبها سهم .. على أنها قائمة منسدلة اختر الأمر Install Add-on from File ، ستظهر لك نافذة تحدد من خلالها مكان الإضافة التي لها الامتداد xpi ، ثم تظهر رسالة فيها أمرين أحدهما Install لتأكيد تنصيب الإضافة والأخرى Cancel لإلغاء الأمر قم بإغلاق الفايرفوكس ثم أعد فتحه افتح أي موضوع من موضوعات المنتدى التي تريد حفظها لتصفحها في وقتٍ لاحق .. ومن خلال قائمة File في المتصفح الفايرفوكس ستجد الأمر المسمى Save Page In Archive As ستفتح لك نافذة الحفظ التي تسمي فيها الملف الأرشيف وتحدد مكانه .. يمكنك تصفح الصفحة وكأنك داخل انترنت بالضبط جرب الإضافة ولا تنساني من دعائك تقبل تحياتي Mozilla Archiver Format.rar

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

شكرا لله ثم لكم احبتي واخوتي

السلام عليكم ورحمة الله وبركاته اخي الكريم تم ربط الفورم بالجدول بالمرفقات مع تحياتي ربط شاشة ( فورم ) ادخال وترحيل واستعلام وتعديل.rar