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

تفضل .... إحصاء من القائمة المتعددة.accdb

اولاأيوجد خطأ بالكود قم بتعديل كلمة إبريل الى أبريل بالكود بملفك كالتالي Case Is = "إبريل": kh_ColumnHidden "FC:FV" الى Case Is = "أبريل": kh_ColumnHidden "FC:FV" ثانيا لضمان الحقوق وكما اشرت في مشاركتى بالاعلي ان الكود من المنتدى وهو للعلامة اخونا من اليمن (وقاها الله وحفظ اهلها من الفتن والحروب ) الاستاذ عبدالله باقشير ثالتا ساحاول ان اشرح الكود الكود يتكون من جزء رئيسي وهو يتم اخفاء كل الاعمدة من العمود Gالى الى اخر عمود XFD بمعني اخفاء كل الاعمدة بالصفحة عد1 الخمسة الاعمده الاولي والتي بها الاسم وايام الحضور الخ Sub kh_ColumnHidden(ColumnAddres As String) ' الغاء اهتزاز الشاشة Application.ScreenUpdating = False ' الصفخة المراد تطبيق الكود عليها Sheets("الحضور والغياب").Select ' اخفاء الاعمدة من العمود G الى اخر عمودXFD Columns("G:XFD").EntireColumn.Hidden = True Columns(ColumnAddres).EntireColumn.Hidden = False End Sub بعد اخفاء جميع الاعمدة عدا الخمسة الاولي سنقوم باظهار الاعمدة التي نحتاجها If Not Application.Intersect(Range("B2"), Range(Target.Address)) Is Nothing Then Select Case Target.Value Case Is = "سبتمبر": kh_ColumnHidden "G:AB" Case Is = "أكتوبر": kh_ColumnHidden "AC:AW" Case Is = "نوفمبر": kh_ColumnHidden "AX:BS" Case Is = "ديسمبر": kh_ColumnHidden "BT:CO" Case Is = "يناير": kh_ColumnHidden "CP:DK" Case Is = "فبراير": kh_ColumnHidden "DL:EE" Case Is = "مارس": kh_ColumnHidden "EF:FB" Case Is = "أبريل": kh_ColumnHidden "FC:FV" Case Is = "مايو": kh_ColumnHidden "FW:GS" السطر الاول B2 وهي الخلية التي يتم اختيار الشهر منها Select Case Target.Value يتم اختيار الحالة (الشهر) حسب القيمة اي قيمة B2 Case Is = "سبتمبر": kh_ColumnHidden "G:AB" في حالة B2 تساوي ستمبر قم باظهار الاعمدة من "G:AB" فلو ذهبت الى شيت الحضور والغياب لوجدت شهر سبتمبر يبدأ من العمو د G وينتهي عند العمود AB وهكذا لبقية الاشهر اتمنى اني قدمت ما يفيدك

نزولا عن رغبة الاحبة بتزويده ببرنامج محاسبة شركات شامل اضع بين ايديكم هذا العمل المتواضع User Name : admin Password : 1 أي رقم سري يواجهكم خلال استخدام البرنامج استعمل 12345 أي سؤال ان اجاهز Accounting Prog.rar

المرفق رقم 2 Course certificates -2.accdb

العفو منكم أستاذي انا اقل طالب علم هذه اللبنة الأولى بناء على افكارى .. اعتقد هكذا يكون الاساس السليم لتلك القاعدة اتفضل فى انتظار رأى حضرتك .. ان شاء الله بعد نكمل خطوة بعد خطوة Course certificates.accdb

انظر هذا المثال على ال_ Fifo

من هنا يمكنك اختيار الأنماط والتنسيقات ..

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

أخيرا بعد محاولات تمكنت من عملها في استعلام واحد ولله الحمد والفضل والمنة .. 😊 السر في الربط بين الجداول وجعله استعلام إجماليات هكذا : شكرا لك مجددا أخي @ناقل 🙂 أدرجت الملف بعد التحديث للاستفادة إحصاء من القائمة المتعددة.accdb

نفس سؤالى وكان هذا الرد الشافى الوافى الكافى من استاذى الجليل ومعلمى القدير و والدى الحبيب الاستاذ @jjafferr

راجع الملف

ابشر ان شاء الله جارى التعديل

هذا الكود يطبع بطابعتية مختلفتين ولكن ل ادري هل بامكانك عمل مجهود للحصول على اسماء الطابعتين لديك Sub print1() Dim s, u s = "Canon MF3010 sur Ne07:" ' اسم الطابعة الاولى u = "HP LaserJet P1005 sur Ne03:" 'اسم الطابعة الثانية '=============== Application.ActivePrinter = s Range("a1:e10").PrintOut ' الطباعة بالطابعة الاولى '=============== Application.ActivePrinter = u Range("a1:e10").PrintOut ' الطباعة بالطابعة الثانية End Sub وهذا الرابط للحصول على اسم الطابعة

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

انت لست جديد على هذا المنتدى لذلك يجدر بك ان تسال سؤال واحد جرب هذا الشي بخصوص الفرز كليك يمين على ورقة العمل ثم اظهار التعليمات البرمجية ثم لصق Option Explicit Private Sub WorkSheet_Change(ByVal Target As Range) If Target.Column = 2 Then Dim lastrow As Long lastrow = Cells(Rows.Count, 1).End(xlUp).Row Range("a7:h" & lastrow).Sort key1:=Range("b7:b" & lastrow), order1:=xlAscending, Header:=xlNo End If End Sub بالنسبة لكود الطباعة sub hidcol Range("C:C").EntireColumn.Hidden = True ActiveSheet.PrintOut Range("C:C,").EntireColumn.Hidden = False end sub 1طباعة.xlsm

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

وعليكم السلام ورحمة الله وبركاته بالتوفيق. ورقة عمل Microsoft Excel جديد.xlsx

شكرا جزيلا

وعليكم السلام 🙂 تحتاج الى دالة التاريخ ، وحتى @ابا جودى صار يستعملها ، وتقدر تشوف المشاركة : جعفر

تفضلي أختي .. الكود يعمل عند إغلاق النموذج وليس البرنامج .. test.rar

طيب ..... شغل الاستعلام رقم 1 وسوف تجد المطلوب في الجدول 2 Database32.accdb

حسب فهمي للمطلوب فلا تحتاج لكتابة today في خلية وإنما تحتاج لكتابة تاريخ البداية مثلا A1 وتاريخ النهاية B1 ونستعمل هذه المعادلة =IF(AND(TODAY()>A1,TODAY()<B1),"yes","no") مع تغيير yes و no إلى النص المراد في الحالتين بالتوفيق

تجربة ربما تفيدك نفس الكود السابق مع بعض التغييرات انظر الملف Option Explicit Sub test1() Dim lr Dim x, r Dim dt1, dt2 dt1 = Date lr = Cells(Rows.Count, "h").End(3).Row Range("i5:i1000").ClearContents For x = 5 To lr dt2 = CDate(Cells(x, "h")) Cells(x, "i").Value = "no" Select Case Cells(x, "h").Value2: Case dt1 To dt2 Cells(x, "i").Value = "ok" End Select Next x End Sub test مياوم.xlsm

لماذا لم تجيبني على سؤالي هل ظهر لك اي خطأ؟ المشكلة كانت بسيطة وخطا في المدى كان يجب عليك تصحيحها ولماذا لم تضع الماكرو الذي اقترحته عليك بالملف لاحظ في المعادلة غيرت الفاصلة الى , بسبب اصدار الاوفيس عندي اذا لم تعمل معك غيرها الى ; وغير اسم الشيت تم تعديل الكود في المشاركة السابقة حضور و غياب بصمة2021.xlsm

The question is not logical as there are many difference in the inputs in the two columns That's my try but of course not the perfect solution Sub Test() Dim e, x, r As Range, c As Range, s As String, v As String, t As String, b As String, d As String, f As String Application.ScreenUpdating = False With ActiveSheet.UsedRange .Columns(3).Interior.Color = xlNone .Columns(14).Interior.Color = xlNone For Each c In .Columns(14).Cells If c.Value = "" Then GoTo iNext b = Replace(c.Value, Chr(218) & Chr(200) & Chr(207) & Chr(32) & Chr(199), Chr(218) & Chr(200) & Chr(207) & Chr(199)) x = Split(b) d = x(0) & Space(1) & x(1) & Space(1) & x(2) b = Replace(c.Value, Chr(236), Chr(237)) x = Split(b) f = x(0) & Space(1) & x(1) & Space(1) & x(2) x = Split(c.Value) v = x(0) & Space(1) & x(1) & Space(1) & x(2) t = Replace(v, Chr(201), Chr(229)) With .Columns(3) For Each e In Array(t, v, d, f) Set r = .Find(e, , xlValues, xlPart) If Not r Is Nothing Then s = r.Address Do r.Interior.Color = vbYellow Rem c.Interior.Color = vbRed Set r = .Find(e, , xlValues, xlPart) Loop Until r.Address = s Set r = Nothing End If Next e End With iNext: Next c End With Application.ScreenUpdating = True End Sub

جرب هذا ام اهم ما تقصد بالمرتجع لذا حسبت المخزون كما يلي ( الرصيد + الوارد) طرحت منهم المنصرف + المرتجع ) تجميع اصناف.rar

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

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

فاتورة مخازن.rar

السلام عليكم ورحمة الله أخي الكريم، في الملف المرفق تجد حلين للمسألة كما طلبت... وأنوّه أن استعمال دالة INDIRECT لا تعمل مع الملفات غير المفتوحة، ولكي تعمل كما تريد يجب فتح كل الملفات التي تستدعيها الدالة INDIRECT في الملف الرئيس... والملف المرفق يضم ملفين أحدهما (الرئيس) required Production.xlsx والثاني (ملف اليوم الأول من الشهر) Daily Plant Report 01-09-2011.xls وقد تم الربط بينهما بوساطة الدالة INDIRECT بطريقة مباشرة (الملفان في الدليل نفسه) ويمكن تغيير صيغة الدليل كما طلبت إلى الدليل E:\Excel work\Daily plant report\September... والمعادلات في الحلين جعلتهما في عمود اليوم الأول من الشهر (لسبب أن ملفات الأيام الأخرى من الشهر غير موجودة أو غير مفتوحة لئلا تُرجع الدالة INDIRECT خطأ في النتيجة من نوع !REF#)... أرجو أن يكون الحل مقبولا ... والشرح مفهوما... أخوك بن علية Required Production.rar

@ابا جودى

السلام عليكم ليس لي سابق خبرة في هذه المسألة ولكني وجدت لك مثالا فآمل ان يكون فيه شيئا مما تبحث عنه FifoStock.rar