عبدالله المجرب

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

السلام عليكم اخي الفاضل تابع هذا الرابط http://www.officena.net/ib/index.php?showtopic=37164&hl=

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

ضع هذا الكود في زر الامر OPENLIST Sheets("Sheet2").Select Unload Me طبعاً "Sheet2" هو اسم الشيت المراد فتحه

جرب المرفق -Warehouses Muu 2013 - نسخة.rar

ضع مرفق ليتم متابعة الخطاء في الكود

اخي يجب ان تتأكد من صيغة حفظ الملف خاصة اذا كنت تستخدم 2007 لابد ان تكون صيغة الملف Xlsm وبتكون شكل ايقونة الملف هكذا

بارك الله فيك اخي ابو محمد === تم اغلاق الموضوع لانه تمت اجابته كما تم فصل السوال الثاني في مشاركة منفصلة للفائدة

ضع مرفق

الخلل اذاً في الملف عندك لاني جربت الكود وكانت النتيجة ممتازة

اخي سعيد جرب الملف إخفاء وحماية المعادلات برسالة تحذيرية والدخول برقم سرى - سعيد بيرم.rar

وهذا تعديل للكود كنت قد اشتغلت عليه وكل الشكر للاستاذين بن عليه واحمد عبد الناصر Private Sub Cmd_action_Click() ' هذا الكود من اعداد الاستاذ عبد الله باقشير Dim iPath As String, Sht As String Dim wo As Workbook ''''''''''''''''''''''' iPath = ActiveWorkbook.Path & Application.PathSeparator ''''''''''''''''''''''' With Me.ListBox1 For i = 0 To .ListCount - 1 If .Selected(i) = True Then Sht = .List(i) Worksheets(Sht).Copy Set wo = ActiveWorkbook ''''''''''''''''''''''''''''''''''''' ' : ??? ????? ??????? With wo ' مطلوب فى الملفات الناتجه حذف العمودين بي و سي فقط ثم حفظ الملف .SaveAs iPath & Sht & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled .ActiveSheet.Columns("B:C").Delete .Save .Close False End With ''''''''''''''''''''''''''''''''''''' End If Next End With Set wo = Nothing MsgBox "تم حفظ الصفحات المحددة فى ملفات منفصله " End Sub

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

السلام عليكم هذا تعديل لكود الاستاذ عبدالله باقشير ub kh_Start() Dim Cel As Range Dim Adr As String Dim r As Integer, rr As Integer MyDay = Val([B3]) Select Case [C3].Value Case Is = "سبتمبر" MyMonth = 0 Case Is = "اكتوبر" MyMonth = 12 Case Is = "نوفمبر" MyMonth = 24 End Select Adr = [J3] For Each Cel In Range("C6:C12") rr = Val(Cel) If rr Then With ورقة2.Range(Adr).Cells(rr, MyDay + MyMonth + 1) .Offset(0, 1).Value = Cel.Offset(0, 2).Value End With End If Next MsgBox "تم الترحيل بنجاح" End Sub

ان كنت تستخدم 2007 شاهد الصور

ساضيف الشرح في موضوع منفصل للفائدة ان شاء الله

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

اخي حسين انا حاولت بمثل ما تريد (اي عند الوقوف في الخانة يتم عرض المعلومات) لكن ما توصلت اليه هو التالي فما رايك

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

السلام عليكم V.Line.ForeColor.SchemeColor = 2 الرقم 2 في هذا السطر للون الاحمر ف كودك المرفق الرقم 0 للون الاسود جرب جعله 2 ولاحظ الفرق

السلام عليكم اخي حسين هل تقصد هكذا شاهد المرفق وبه الدالة الخاصة بك معلومات دالة.rar

جرب المرفق بعد التعديل الفاتورة....rar

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

جرب هذه المعادلة =SUM(SUMIF(A1:C13;"اثاث";C1:C13);SUMIF(A1:C13;"مفروشات";C1:C13))