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

برنامج مراقبة المخزون بمناسبة شهر رمضان مراقبة المخزون.xlsm

مخازن كامل باس ورد 0 الثلاجات مخازن 20215.rar

لم أقصد الإساءه لأحد والله أعلم بالنوايا .. وأعود وأكرر الشكر للجميع

نعم صدقت وفاتنى ذلك تعديل الملف BIOCHEMICAL TEST1.xlsb

محاولتي معالجة بيانات الحضور تحتاج غالبا إلى تدخل يدوي، هذا ما استطعت عمله. AttendanceIII_01.xlsm

السلام عليكم و رحمة الله و بركاته أخي العزيز،،ارى اجابة استاذ عبدالله متوافقة تماما كما طلبت ولكن اعتقد المطلوب من طلب منك مختلف ، و المطوب هو تغير لون سهم و اتجاهه على حسب معايير عمود Normal Value لإختبار فئة في عمود Test كما في الصورة ، لا العمود كامل على 3 معايير ،هذا حسب فهمي و الله اعلم.

كلام غير دقيق، نعم في شفرتي هناك مشكلة واحدة لاختلاف في دالة التنسيق بين الإكسل والبيزك، ففي الإكسل "General" تكون في الأكسس "General Number" وهذا سبب بخطأ واحد فقط لرقم 52 والحل إما بعمل تبديل التنسيق للخلية أو تبديله في الشفرة أو نأخذ قيمة Text بدلا من Value للخلية المصدر. كما أنصحك بترك التفاضل بين الخبراء لأننا خضنا معركة كبيرة مع مالك الموقع لتجنب هذا التفاضل بتغيير الوصف من "أفضل إجابة" إلى "تمت الإجابة"، فغالبا تكون بها غبن للآخرين، فالأستاذ عبدالله أسس للكود وقبل طلبك الأخير باستخدام التنسيق، وكذلك الأستاذ محمد هشام قدم حله بعد اطلاعه على الحلين السابقين واستفاد من المقارنة وقد عدل مرفقه بعدها. لا يهمني اختيار جوابي كما فعلت ولا يعني ملاحظتي لك التقليل من جهد أساتذتي فإن أمكنك إعطاء الاختيار لأحد أساتذتي فافعل.

I need the program please Best wishes

وعليكم السلام ورحمة الله تعالى وبركاته بطريقة أخرى Option Explicit Sub test() Dim WS As Worksheet, tbl As Long, tmp As Long, i As Long Dim n As String, Max As Long, ky As Boolean Max = 34 Set WS = Sheets("ورقة1") Application.ScreenUpdating = False Application.Calculation = xlCalculationManual On Error Resume Next tbl = WS.Columns("B:M").Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row On Error GoTo 0 tbl = IIf(tbl = 0, 6, tbl) tbl = IIf(tbl > Max, Max, tbl) WS.Range("N6:N" & tbl).ClearContents For tmp = 6 To tbl n = "" ky = False For i = 2 To 13 If WS.Cells(tmp, i).Value <> "" Then n = IIf(n = "", WS.Cells(5, i).Text, n & " - " & WS.Cells(5, i).Text) If Not ky Then WS.Cells(tmp, 14).NumberFormat = WS.Cells(tmp, i).NumberFormat ky = True End If End If Next i WS.Cells(tmp, 14).Value = n Next tmp Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub DATA V1.xlsb

تفضل يا @عالم الهندسة المرفق بعد التعديل . ووافني بالرد . حجز (2).rar

وعليكم السلام ورحمة الله تعالى وبركاته حاول دمج الأكواد السابقة في كود واحد لتتمكن من طباعة وصل معين أو عدة وصولات من إختيارك بالطريقة التالية Sub Choose_the_print() Dim tmp As Variant, arr As Variant, n As Range Dim OnRng As String, xInput As String, a(1 To 6) As String Dim WS As Worksheet: Set WS = Sheets("ورقة1") a(1) = "H2:L16": a(2) = "N2:R16": a(3) = "T2:X16": a(4) = "H18:L32": a(5) = "N18:R32": a(6) = "T18:X32" xInput = InputBox("يرجى إدخال أرقام الوصولات للطباعة" & vbCrLf & "مفصولة بفاصلة (-) مثل: 3-2-1", "إختيار الوصولات") If Trim(xInput) = "" Then: MsgBox "لم يتم إدخال أي أرقام يرجى المحاولة مرة أخرى", vbExclamation: Exit Sub tmp = Split(xInput, "-") For Each arr In tmp If IsNumeric(Trim(arr)) Then If Val(arr) >= 1 And Val(arr) <= 6 Then OnRng = a(Val(arr)) Set n = WS.Range(OnRng) n.PrintOut Copies:=1, Collate:=True Else MsgBox "رقم الوصل " & arr & " غير موجود يرجى التأكد", vbExclamation Exit Sub End If Else MsgBox "إدخال خاطئ " & arr, vbExclamation Exit Sub End If Next arr MsgBox "تمت الطباعة بنجاح", vbInformation End Sub مثال.xlsm

أخي ابو الآء برنامجك لا يخفي الجداول المرتبطة ولكنك جعلتني افتش ملفاتي القديمة ، ووجدت الحل جعفر Show_Hide_Tables.zip