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

السلام عليكم ورحمة الله وبركاته اليكم دالة البحث ب vlookup بشروط متعدده كنت سابقا قد اعددت ملف مشابه ولكن كان بداله عاديه اما الجديد هو استخدام vlookup باكثر من شرط 3 او اكثر . بدالة صفيف دون الحاجه الى اعمده مساعده او مشابه اترككم مع الملف واسأل الله أن ينفعنا و إياكم بما علمنا و و أن يرزقنا الإخلاص في القول و العمل VLOOKUP بشروط.rar VLOOKUP بشروط xl2003.rar

بسم الله الرحمان الرحيم السلام عليكم حركة اليوم كالعادة متعلقة بالجانب الفني و الجمالي لليوزر فورم اقتبست هاته الفكرة من تجليد الفورم في VB6 و VBNET بواسطة أداة Active Skin و وجدة ان هاته الأداة متوفر او متوافقة بالفعل مع VBA لذى بحثت وحاولت الى ان توصلت الى الاتي ا36 شكل (ثيم) مميز يمكنكم استعمالها بسهولة فس برامجكم ندخل الى التنفيذ اولا نحتاج الى تثبيت الأداة ActiveSkin Control ان لم تكن مثبت لديكم ولفعل ذالك اتبع الشرح المصور الاتي بهده الطريقة نكون انتهينا من عملية تثبيت الادات الان ناتي الى اضافة الاداة كاي ادات اخرى الى صندوق الادواة نقوم الان باضافة الاداة الى الفورم وايضا نقوم باضافة ليست بوكس ثم قم بنسخ هذا الكود في الفورم Option Explicit Private No As Double Private FSO As Object, Klasir As Object, Dosya As Object Private SeçilenDosya As String Private Const hWnd As Long = &H0 Private Sub UserForm_Initialize() On Error Resume Next Application.Visible = False With Me .Caption = "UserForm Skin" .Height = 226 .Width = 358 End With With ComboBox1 .Left = 6 .Top = 6 .Height = 18 .Width = 114 End With Call SkinDosyaListele End Sub Private Sub UserForm_Terminate() On Error Resume Next Contrôle1.Empty End Sub Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer) On Error Resume Next Application.Visible = True End End Sub Private Sub ComboBox1_Change() On Error Resume Next SeçilenDosya = ComboBox1.List(ComboBox1.ListIndex, 1) Me.Caption = ComboBox1 With Contrôle1 .LoadSkin SeçilenDosya .ApplySkin hWnd .ZOrder 1 End With DoEvents End Sub Sub SkinDosyaListele() On Error Resume Next No = 0 Set FSO = VBA.CreateObject("Scripting.FileSystemObject") Dim Pth As String: Pth = ThisWorkbook.Path & "\Skins\" Set Klasir = FSO.GetFolder(Pth) For Each Dosya In Klasir.Files ComboBox1.AddItem Dosya.Name ComboBox1.List(No, 1) = Dosya No = No + 1 Next Dosya End Sub تم ارفاق مثال عملي للموضوع لكي يشتغل عنك المثال قم اولا بتثبيت الادات كما وضحت سابقا ولا تنسى وضع الملف بعد الحفظ مع مجلد Skins في نفس المسار سيضهر لك يوزر فورم به قائمة منسدلة بالشكل العادي قم باختيار أي اسم من القائمة ولاحظ مايحدث المجلد Skins يحوى السناكات بعض الصور المأخوذة للفورم بعد التجليد اهدي هذه الحركة الى اخي وصديقي ضاحي الغريب الذي عمل لي الشرح المصور اعلاه جازاه الله عنا كل الخير ارجو ان يفيدكم الموضوع وينال اعجابكم تحياتي للجميع اخوكم في الله شوقي ربيع الشرح المصور.rar ACTSKIN4 الاداة.rar مثال عملي عن تجليد الفورم.rar

انا قلتها سابقاً . الاكسس يصنع لك ما تشاء

السلام عليكم تم عمل المطلوب بالمرفق ادناه مع مراعات ان رؤوس الاعمدة تكون عبارة عن تواريخ بدل مما ذكرة اعلى1, اعلى2 ...... وذلك لكي يتعرف الكود هل تم الترحيل في ذلك اليوم ام لا كما لاحظة انه يمكن لكود الترحيل ان يسبق استقبال بالبيانات من المصدر الخارجي في حالت فتح الملف بعد الساعة الثلاثة مساءا لذى تم اضافة كود عند اقلاع الملف يأخر عملية الترحيل 30 ثانية لإعطاء الملف فرصة في جلب البيانات من المصدر الخارجي ان لم تكن المدة كافية فما عليك سوى زيادة مدة التأخير في هذا الكود Private Sub Workbook_Open() Application.OnTime Now + TimeValue("00:00:30"), "Verification" End Sub الاكود المستعمل في عملية الترحيل Option Explicit Dim Sh As Worksheet, WrSh As Worksheet Sub Envoi() Dim Nm As Byte For Nm = 3 To 8 Set WrSh = ThisWorkbook.Sheets(Nm) WrSh.Select If WrSh.Range("D1") <> "" Then WrSh.Range(Columns(3), Columns(3).End(xlToRight)).Cut Destination:=Range("D1") Else WrSh.Columns(3).Cut Destination:=Range("D1") End If WrSh.Columns(2).Copy WrSh.Range("C1").PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False WrSh.Range("C1") = Date Next End Sub Sub Verification() Dim Nm As Byte For Nm = 2 To 7 Set WrSh = ThisWorkbook.Sheets(Nm) If WrSh.Range("C1") = Date Then Exit Sub If Time > TimeValue("15:00") Then Envoi Next End Sub ايضا يمكنك التعديل في الوقت الذي ان يتم الترحيل فيه من هذا الكود تحياتي للجميع تداول على االاكسل اوفسينا.rar

أعتقد أنه يجب أن يكون مع الملف مرفق ساعة على شكل ملف بمتداد SWF

السلام عليكم كما ذكر الاستاد دغيدي الملف لا يحوي اكواد ولا معادلات هي مجرد صورة و لتشغيل ساعة او أي ملف من نوع swf على أي اصدار تحتاج الى ادراج اداة WebBrowser في الشيت او في الفورم من صندوق الادوات الاضافية وان يكون لديك ملف فلاشي للساعة ثم تربط الاداة بمسار الملف الفلاشي Me.WebBrowser1.Navigate "هنا ضع مسار الملف الفلاشي"

السلام عليكم استبدل اكواد الملف بهذه الاكواد Option Explicit Sub Hidden2() Dim Cl As Range Application.ScreenUpdating = False For Each Cl In Range("A14:A213") If Cl = "" Then Cl.EntireRow.Hidden = True End If Next Cl [kh_Row2] = "اضهار جميع الصفوف الفارغة" Application.ScreenUpdating = True End Sub Sub UnHidden2() Dim Cl As Range Application.ScreenUpdating = False For Each Cl In Range("A14:A213") If Cl.EntireRow.Hidden = True Then Cl.EntireRow.Hidden = False End If Next Cl [kh_Row2] = "اخفاء الصفوف الفارغة " Application.ScreenUpdating = True End Sub Sub Rows() ActiveSheet.Unprotect If [kh_Row2] = "اضهار جميع الصفوف الفارغة" Then UnHidden2 Else Hidden2 End Sub تحياتي

السلام عليكم أخي العزيز ddd تخبر الاكسل أنك تريد اليوم بالتنسيق العادي (الشائع : الإنجليزي) Saturday, Sunday,... أما إن كنت تريد غير الإنجليزية فلابد من أن تسبق التنسيق ببادئة يكون لها علاقة بكود صفحة اللغة التي تريدها مثلا B2ddd للتنسيق بالعربية (السبت - الأحد -... وهذه للتنسيق بالهندي (शनि. , रवि. , सोम. , मंगल. , बुध. , गुरु. , शुक्र.) [$-4010439]ddd وهذه للتنسيق بلغة الأفريكانو ( Sat , Son , Maan , Dins , Woen , Dond , Vry) [$-436]ddd

ألا من ملبي لنداء التثبيت .. جزاكم الله خيرا أيها المشرفون

السلام عليكم يتم الترحيل اوتوماتيكيا مرة واحدة في اليوم بعد الساعة الرابعة (حسب ساعة الجهاز لديك) ا و ذألك لجميع الاوراق التي ذكرتها في طلبك الاخير الى العمود الذي يليه ثم الى الذي يلي الذي يله وهكذا كل يوم ارجو ان يكون هو المطلوب الاكواد المستعملة Option Explicit Dim Sh As Worksheet, WrSh As Worksheet Sub Envoi() Dim Nm As Byte For Nm = 2 To 7 Set WrSh = ThisWorkbook.Sheets(Nm) Dim Lrw As Long: Lrw = WrSh.Cells(WrSh.Rows.Count, 1).End(xlUp).Row Dim Lcm As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column + 1 Dim i As Integer If WrSh.Range("A1") = "" Then Lcm = Lcm - 1 WrSh.Cells(1, Lcm) = Date For i = 2 To Lrw WrSh.Cells(i, Lcm).Value = WrSh.Range("C" & i).Value Next Next End Sub Sub Verification() Dim Nm As Byte For Nm = 2 To 7 Set WrSh = ThisWorkbook.Sheets(Nm) Dim Lcm As Long: Lcm = WrSh.Range("IV1").End(xlToLeft).Column If WrSh.Cells(1, Lcm) = Date Then Exit Sub Next If Time > TimeValue("16:00") Then Envoi End Sub تحياتي للجميع zmzm اوفسينا.rar

السلام عليكم ادخل على صفحة (أعلى) واضغط زر تنفيذ ولاحظ ماذا يحدث تحياتي zmzm اوفسينا#1.rar

السلام عليكم هذا الملف يحوي على شيت لداتا يكون مستقبل البيانات الخارجية في العمود الاول 12 شيت بأسماء اشهر السنة لكي ترحل اليها بيانات الداتا (العمود الاول من الداتا فقط) الترحيل يكون حسب الشهر الحالي (حسب ساعة الجهاز) بحيث يقوم الكود بفحص الشيت المتوافق مع الشهر الحالي ثم يرحل بيانات الداتا الى اول عمود فارغ في ذالك الشيت مرة واحدة فقط في اليوم بعد الساعة الرابعة مساءا عند انتهاء الشهر سيكون لديك اعمدة بعدد ايام ذالك الشهر ورأس كل عمود يكون عبارة عن تاريخ اليوم الاكواد المستعملة Option Explicit Dim Sh As Worksheet, WrSh As Worksheet 'ÝÍÕ ÇáÔíÊ ÇáãÊæÇÝÞ ãÚ ÇáÔåÑ ÇáÍÇáí Function NomFeuil(Mois As Byte) As String Set Sh = ThisWorkbook.Sheets("Data") Dim r As Byte For r = 1 To 12 Select Case Mois Case r NomFeuil = Sh.Range("B" & r): Exit Function End Select Next End Function 'ÊÑÍíá ÚãæÏ ÇáÏÇÇ Çáì Çæá ÚãæÏÝÇÑÛ Ýí ÇáÔíÊ ÇáãÊæÇÝÞ ãÚ ÇáÔåÑ ÇáÍÇáí Sub Envoi() Set Sh = ThisWorkbook.Sheets("Data") Set WrSh = ThisWorkbook.Sheets(NomFeuil(Month(Now))) Dim Lrw As Long: Lrw = Sh.Cells(Sh.Rows.Count, 1).End(xlUp).Row Dim Lcm As Long: Lcm = WrSh.Cells(1, 16384).End(xlToLeft).Column + 1 Dim i As Integer If WrSh.Range("A1") = "" Then Lcm = Lcm - 1 WrSh.Cells(1, Lcm) = Date For i = 2 To Lrw WrSh.Cells(i, Lcm) = Sh.Range("A" & i) Next End Sub 'ÇáÊÑÍíá ÍÓÈ ÇáæÞÊ Sub Verification() Set WrSh = ThisWorkbook.Sheets(NomFeuil(Month(Now))) Dim Lcm As Long: Lcm = WrSh.Cells(1, 16384).End(xlToLeft).Column If WrSh.Cells(1, Lcm) = Date Then Exit Sub If Time > TimeValue("16:00") Then Envoi End Sub ارجو ان يكون المطلوب تحياتي للجميع Test.rar

السلام عليكم حسب مافهمت اخ زمزم ان الخلايا التي تتلقى بيانات من مصدر خارجي تريد نسخها الى العمود التالي بشرط مره فقط في اليوم وبشرط مابين الساعه الرابعة عصرا فقط استخدمنا كود الاخ محمود الشريف مع بعض الاضافات اليك الكود غير المدى في اول الكود Private Const FD = "yyyy/mm/dd" Private Const FT = "hh:mm:ss" ' الخلايا التي تتلقى قيمها من مصدر خارجي Private Const Are As String = "$A$2:$A$500" Dim Tim_t Dim Dn As Range Dim Tn As Range Dim Tim Private Sub Ali_Tim() Set Tn = [XF1] Set Dn = [XG1] Tim_t = Now + TimeValue("00:00:05") Application.OnTime Tim_t, "Trn_Dt", , True Dx = IIf(Dn = "", Val(Date) - 1, Val(Dn)) If Time > TimeValue("16:00") And Time < TimeValue("16:59") Then If Dn = "" Then Tim_Cod ElseIf Dn = Date And Hour(Tn) = Hour(Tim) Then ElseIf Not Dx = Val(Date) Then Tim_Cod End If End If End Sub Private Sub Tim_Cod() Dim Rng As Range Set Tn = [XF1] Set Dn = [XG1] '================================ For Each Rng In Range(Are) If Rng > Empty Then With Rng Lc = Cells(.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Column Cells(.Row, Lc) = Rng End With End If Next '================================ Dn = Format(Now, FD) Tn = Format(Time, FT) Set Rng = Nothing Set Dn = Nothing: Set Tn = Nothing End Sub Private Sub Trn_Dt() Calculate Ali_Tim End Sub Sub auto_open() Ali_Tim End Sub Sub auto_close() On Error Resume Next Application.OnTime Tim_t, "Trn_Dt", , False End Sub

السلام عليكم أهلا ومرحبا أخي الكريم الموضوع بسيط وميسر بإذن الله (مجاني) إبدأ أولا بالبحث والإطلاع في هذا المنتدي وإليك بعض الروابط لدورات أو مواضيع ذات صلة وستجد غيرها الكثير بالبحث إن شاء الله http://www.officena.net/ib/index.php?showtopic=39323 http://www.officena.net/ib/index.php?showtopic=29207&hl=%D8%AF%D9%88%D8%B1%D8%A9 http://www.officena.net/ib/index.php?showtopic=33308

تابع الدرس الثانى ندخل الى مرحله تنفيذ الماكرو الذى قمنا بتسجيله ولها خطوات معينة كالتالى : نذهب الى الشيت ثم نضغط على Insert تظهر لنا نافذة نختار منها Button ثم نقوم بوضعه داخل الشيت كما بالصور التالية ثم نقوم بالضغط على الزر كليك يمين ونختار تعيين ماكرو كالتالى تظهر لنا نافذة نختر منها اسم الماكرو وهنا قد اسميته MZM_ELSHRIEF ثم نختار This Workbook ثم نضغط على OK كالتالى الآن يمكنك تنفيذ الماكرو الذى قمنا بتسجيله بمجرد الضغط على الزر أى Button يمكنك أيضا تغيير اسم الزر اذا اردت ذلك كالتالى بالضغط كليك يمين على الزر تظهر لك نافذة اختر منها اضافة نص حفظ الملف عند حفظ الملف تظهر لنا رساله كما بالصورة التالية نضغط على زر NO فتظهر لنا رساله أخرى كما بالصورة التالية نضغط على زر Yes فتظهر لنا نافذة كما بالصورة التالية نقوم بإختيار من Save as type Excel Macro-Enbled Workbook ثم نضغط على Save الخيار التالى كما بالصورة التالية فتكون أيقونه الملف كما بالصورة التالية انتهى الدرس الثانى مرفق ملف PDF به كامل الدرس الثانى يرجى فى حاله هناك استفسار أن يكون فى مضمون الدرس حتى لا يتم التشتيت وتقبلوا منى وافر الاحترام والتقدير الدرس 2.rar

بسم الله الرحمن الرحيم بعض الاعمال السابقة دوال دالة ( VLOOKAnyCol ) تبحث فى اى عمود من الجدول وتستخرج النتيجة من آخر دالة VLOOK2ALL لإستخراج كل حالات البحث دالة VLOOKON بلا حدود تبحث فى عدة جداول دالة تجزئة الاسماء و الارقام دالة "IFYES" اقوى واسهل من "IF" مع احتمالات اكثر دالة اتخاذ القرار ( Resolve ) لتقيم التقديرات و المعدلات والنسب ادوات ذكية استرجاع اعدادات الاكسل الاصلية التخلص من علامات خطأ المعادلات نسخ الاكواد من ملف الى ملف أداة تحويل صيغ المعادلات الى اكواد مصباح علاء الدين للبحث اقوى دالة بحث الحلول الذكية و شريط الادوات الذكية التحكم بأشرطة الادوات والقوائم المنبثقة تلوين السطور الفردية أو الزوجية إكسيل كاميرا برامج واكواد كيفية الحصول على سريال نمبر الهارد ديسك الباحث الشامل اعداد الجدول الزمنى للمشروعات ( مخطط جانت ) إنشاء قوائم منسدلة مرتبطة متعددة المستويات تصدير مدى محدد الى الوورد حل مشكلة عدم ظهور اكثر من 1000 سجل فى قوائم التصفية التلقائية إستخراج النتائج بشرطين صيغة ظريفة سلسلة كيف تدرج دالة فى الاكسل لتكون متاحه لكل الملفات بإنشاء ملف ( AddIn ) يحتوى على دوالك الخاصة منع حفظ الملف بأسم آخر زيادة عملية التراجع و الإعادة ( Undo / Redo ) في الاكسل أكثر من 16 مرة اكسيل 11 كشـف تـوزيـع فئـات النقـديـة كشـف صـرف النقـديـة بالفئـات المتـاحـة إستيراد وتصدير جدول إكسيل من وإلى الأكسيس صمم توقيعك الخاص او علامتك المائية لملفاتك الخاصة كود الدوائر الحمراء والاحرف الخاصة لدرجات الطلاب نموذج طباعة الشهادات المدرسية مع دوائر الارقام برنامج طباعة الشهادات للمرحلة الابتدائية_1 برنامج طباعة الشهادات للمرحلة الابتدائية_2 برنامج طباعة نماذج الشهادات للمرحلة الاعدادية قائمة منسدلة تفلتر مع الاحرف او الاسماء المحددة برنامج حفظ بيانات الشيكات والبحت عنها اكواد و اوامر ( VBA ) مفيدة القائمة المنسدلة المرتبطة بقوائم متعددة المدى او النطاق ( ثابت / ديناميكى ) الارقام العشوائية بدون تكرار البوم للصور والمعروضات, بدون حدود ***** ***** ***** ***** *****

بسم الله الرحمن الرحيم السلام عليكم ورحمة الله وبركاته اهديكم ما وعدتكم به الاصدار الثاني من برنامج خبور المحاسبي عملة رئيسية وعشر عملات فرعية مع حساب فروقات سعر عملة تلقائي ======================= في المرفق مثال عملي على مصداقية عمل البرنامج ولهذا اقدم اليكم الآن البرنامج من جديد مع بعض الاضافات الجديدة مع مثال عملي يتكون من اكثر من 10000 سجل لقاعدة البيانات حسابات كشف العملاء اكثر من 200 عميل ومورد حسابات الميزانية 24 حساب يمكنكم التجربة عمليا في الآتي: 1-استخراج اي قيد وقم بالتعديل عليه لاحظ سرعة القيام بالتعديل مع وجود اكثر من 10000 سجل استخرج القيد لترى ان تمت فيه التعديلات ام لا 2- قم بتغيير اسعار العملات في صفحة الاعدادات وانتقل الى كشف العملاء والموردين ثم ميزان المراجعة سترى ان الفروقات قد تمت تلقائيا 3-افتح قاعدة البيانات واعمل خلل في صحة الميزان ( لانه لايمكنك عمل ذلك من خلال التعديلات لان القيد لايترحل الا ان كان متوازنا) سترى ظهور الخلل في ميزان المراجعة ولن يدخل هذا الخلل في فروقات اسعار العملات وهناك الكثير من الملاحظات التي لن تروها الا بالتجربة العملية ولهذا قمت بعمل هذا المثال ( هي قيود غير حقيقه لانها مكرره ولكن من اجل من اراد ان يعمل بالبرنامج وهذا الذي اريده ان يثق في مصداقية هذا العمل ) هذا الذي كان في قلبي واردت ان اوصله اليكم وقد بذلت في هذا البرنامج كل ما استطيعه حسب ما اعطانا الله من علم وقدرة ولله الحمد ولا اريدكم ان تمروا عليه مرورا عابرا اريد ان اطور هذا البرنامج و لكن لله المراد فيما اراد جزاكم الله الف خير تحياتي للاخ محمد عسكر الذي يشرح صدري بردوده وليس لي انا فقط ولكن لكل من قدم مساهمه في هذا المنتدى جزاك الله الف يااخ محمد قد التمست هذه المره بعض الذي اخبرتنا عنه سابقا ارسل لي ايميل على khboor@gmail.com تحياتي للجميع اخوكم / خبور اخوكم/ خبور _____________________2_3.rar