اذهب الي المحتوي
أوفيسنا

a.kawkab

02 الأعضاء
  • Content Count

    85
  • تاريخ الانضمام

  • تاريخ اخر زياره

السمعه بالموقع

25 Excellent

1 متابع

عن العضو a.kawkab

  • الإسم الفعلي
    الإســم

البيانات الشخصية

  • Gender (Ar)
    ذكر
  • Job Title
    cairo
  • البلد
    مصر

وسائل التواصل

  • Yahoo
    a.kawkab@yahoo.com

اخر الزوار

402 زياره للملف الشخصي
  1. إنا لله وإنا اليه راجعون البقاء لله ... اللهم اغفر لها وارحمها وأدخلها جنات الفردوس الأعلى , وألهم اهلها الصبر والسلوان
  2. عمل رائع استاذ محمد جزاك الله حيرا ممكن تعديل اخر من فضلك على نفس الكود بيحيث يكون مجلد الاخراج فى نفس مسار الملف الاصلى لتعم الفائدة وشكرا لك
  3. لغلق الملف الخارجي ( touati1 ) اضف هذا السطر فى نهاية الكود Windows("touati1.xlsx").close
  4. للأسف ليس هذا المطلوب هذا المسار يتطلب تغييره تبعا للجهاز اللى هاتشتغل عليه / التعديل المطلوب ان يكون فى نفس المسار مثل ThisWorkbook.Path & "Output", FileFormat:=51= بحيث يعمل على اى جهاز فى اى مكان دون تعديل
  5. ممكن استاذ عبد الفتاح تعدل الكود بحيث يصبح ملف الاستيراد فى نفس مسار الملف لانى بيضبط مغى الملف فى اى قولدر اخذن فيه ماعدا فى نفس المسار ما ضابطه معى فلو تكرمت ممكن تعدل المسار فى نفس مسار الملف
  6. Sub Export_Specific_Sheets_To_One_Workbook_Using_Arrays() Dim ws As Worksheet Dim sSheets() As String Dim n As Long Application.ScreenUpdating = False For Each ws In Worksheets(Array("انسولين الهيئة", "انسولين الطلاب والرضع", "تقارير الاصناف")) n = n + 1 ReDim Preserve sSheets(1 To n) sSheets(n) = ws.Name Next ws Worksheets(sSheets).Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Output", FileFormat:=51 Application.DisplayAlerts = True ' ' For Each ws In ActiveWorkbook.Worksheets ' ws.UsedRange.Value = ws.UsedRange.Value ' Next ws For Each ws In ActiveWorkbook.Worksheets ws.Unprotect 123 ws.UsedRange.Value = ws.UsedRange.Value ws.Protect 123 Next ws ActiveWorkbook.Close True Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub تم تعديلالكود بواسطة الاستاذ ياسر خليل جزاه الله خيرا وتم المطلوب والحمد لله وهذا الجزء هو ماتم تعديله For Each ws In ActiveWorkbook.Worksheets ws.Unprotect 123 ws.UsedRange.Value = ws.UsedRange.Value ws.Protect 123 Next ws
  7. ارجو من الاساتذة الافاضل ان يكون لدى احدهم حل للمطلوب التقارير.xlsm
  8. بعد اذن الاستاذ سليم جرب هذه المعادلة فى الخلية f5 ثم اسجب نزولا لاسفل =F$4-D5
  9. Sub Export_Specific_Sheets_To_One_Workbook_Using_Arrays() Dim ws As Worksheet Dim sSheets() As String Dim n As Long Application.ScreenUpdating = False For Each ws In Worksheets(Array("تقاريرانسولين الهيئة", "تقارير انسولين الطلاب والرضع", "تقارير الاصناف")) n = n + 1 ReDim Preserve sSheets(1 To n) sSheets(n) = ws.Name Next ws Worksheets(sSheets).Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Output", FileFormat:=51 Application.DisplayAlerts = True For Each ws In ActiveWorkbook.Worksheets ws.UsedRange.Value = ws.UsedRange.Value Next ws ActiveWorkbook.Close True Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub الكود السابق يقوم بتصدير الشيتات المحددة الى شيت منفصل بدون اظهار المعادلات لكن عندما اقوم بحماية شيتات التقارير يرفض التصدير الا فى حالتين الاولى ان الغى الحمايه وهى ضروريهلعدم العبث فى المعادلات وبالتالى يحدث احطاء فى التفارير الثانية تعطيل الجزء ws.UsedRange.Value = ws.UsedRange.Value من الماكرو وفى هذه الحالة يتم تصدير التقارير مع المعادلات والمطلوب التصدير بدون معادلات اى قيم فقط مرفق صور توضيحية للمشكلة بالاضافة لملف العمل وكود الغاء الحماية123 التقارير.xlsm
  10. اساتذة المنتدى الكرام مطلوب تعديل الكود التالى بحيت يتم تصدير البيانات بدون معادلات Sub Export_Specific_Sheets_To_One_Workbook_Using_Arrays() Dim ws As Worksheet Dim sSheets() As String Dim n As Long Application.ScreenUpdating = False For Each ws In Worksheets(Array("تقارير الانسولين", "تقرير الأصناف", "تقارير التكلفة" _ , "تقارير الريبافيرين والms", "هرمون النمو والثلاثيميا", "التذاكر الطبية")) n = n + 1 ReDim Preserve sSheets(1 To n) sSheets(n) = ws.Name Next ws Worksheets(sSheets).Copy Application.DisplayAlerts = False ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\Output", FileFormat:=51 Application.DisplayAlerts = True For Each ws In ActiveWorkbook.Worksheets ws.UsedRange.Value = ws.UsedRange.Value Next ws ActiveWorkbook.Close True Application.ScreenUpdating = True MsgBox "Done...", 64 End Sub
  11. االسلام عليكم اليك هذا الملف لعله يفى بالغرض ترحيل واستدعاء.xlsm
  12. ادخلت الدالة تعمل جيدا عندما ادخل البيانات يدوى ولكن عند النسخ من الفورم تعطى الناتج اصفار في الكود جربي تبديل هذا السطر .Cells(x, y) = Me.Controls("TextBox" & i) الى .Cells(x, y) =Val(Me.Controls("TextBox" & i)) شكرا استاذنا الفاضل استاذ سليم وجزاك الله خيرا ونفعنا بعلمك تم المطلوب بحمد الله وجزاك الله خيرا
  13. شكرا استاذنا الفاضل اشتاذ سليم وزادك الله بسطة فى العلم وجعله فى ميزان حسناتك اوفى الكود واراحنى ولكن لدى مشكلة صغيرة فى خلايا الجمع عندما يتم نسخ الخلايا الفارغة من الفورم يعطينى خطأ value وجربت دالة if error دون جدوى فاطمع فى سعة علمك لحل هذه المشكلة مرفق صورة توضيحية
×
×
  • اضف...