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

Sub Test() Dim a, w, ws As Worksheet, f As Boolean, i As Long, ii As Long, k As Long, m As Long Application.ScreenUpdating = False Set ws = ActiveSheet ws.Range("B20").CurrentRegion.Offset(2).ClearContents w = ws.Range("D20").Value If w = Empty Then MsgBox "Enter ID First", vbExclamation: Exit Sub a = ws.Range("A3:P" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value ReDim b(1 To UBound(a, 1) * 4, 1 To 5) For i = LBound(a) To UBound(a) If a(i, 4) = w Then k = k + 1 b(k, 1) = a(i, 1) b(k, 2) = a(i, 2) m = 0 For ii = 5 To 14 Step 3 If a(i, ii) <> Empty Then f = True b(k + m, 3) = a(i, ii) b(k + m, 4) = a(i, ii + 1) b(k + m, 5) = a(i, ii + 2) m = m + 1 End If Next ii If m > 0 Then k = k + m - 1 If f = False Then b(k, 1) = Empty: b(k, 2) = Empty: f = False: k = k - 1 End If Next i If k > 0 Then ws.Range("B22").Resize(k, UBound(b, 2)).Value = b Application.ScreenUpdating = True End Sub

Change the worksheet code names in VBE window to wsList and wsMonthlyAbsence Sub Test() Dim x, v, f As Boolean, sTemp As String, lr As Long, c As Long, tot As Long, r As Long, m As Long, i As Long, ii As Long, col As Long Application.ScreenUpdating = False With wsList lr = .Cells(Rows.Count, "D").End(xlUp).Row wsMonthlyAbsence.Range("C6:J100").Value = Empty For c = 5 To 36 tot = Application.WorksheetFunction.CountA(.Range(.Cells(8, c), .Cells(lr, c))) If tot = 0 Then GoTo NXT f = True: m = 0: col = 0: sTemp = vbNullString For r = 8 To lr If .Cells(r, c).Value <> "" Then x = Application.Match(.Cells(7, c).Value2, wsMonthlyAbsence.Columns(2), 0) If Not IsError(x) Then If f Then wsMonthlyAbsence.Cells(x, "C").Value = tot wsMonthlyAbsence.Cells(x, "D").Value = lr - 8 + 1 - tot f = False End If sTemp = sTemp & IIf(sTemp = Empty, Empty, ",") & .Cells(r, 4).Value End If End If Next r If sTemp <> Empty Then v = Split(sTemp, ",") For i = LBound(v) To UBound(v) Step 3 For ii = 0 To 2 m = m + 1 If m > UBound(v) + 1 Then Exit For wsMonthlyAbsence.Cells(x + ii, col + 5).Value = v(i + ii) Next ii col = col + 1 Next i End If NXT: Next c End With Application.ScreenUpdating = True MsgBox "Done...", 64, "LionHeart" End Sub

هذا أحد البرامج الأجنبية نزلته من فترة قريبة لعله يفيدكم 🙂 Speech.accdb وهذا ملف آخر فيه مجموعة من المكتبات الصوتية لمختلف اللغات ومن ضمنها العربية Translate&Speak_v4.3_64-bit.zip

بعد اذن الاخوة هذا الشيء ينسخ المدى المحدد ويحوله الى pdf حدد المدى الذي تريد وفعل الماكرو Option Explicit Sub rngSelect() Dim R Dim fil_name fil_name = ThisWorkbook.Path & "\" & fil_name & Format(Now(), "dd-mm-yyyy- hh.mm.ss") R = (Selection.Address) Range(R).ExportAsFixedFormat Type:=xlTypePDF, Filename:=fil_name MsgBox "النسخة تجدها في نفس مكان الملف الاصلي", vbInformation End Sub

وعليكم السلام ضع الكود بالشكل التالي stLinkCriteria = "[Sys_ID]=" & Me![Sys_ID] & "And [Sys_Year]=" & Me![Sys_Year] & "and [Sys_Type]='" & Me![Sys_Type] & "'"

شاهد المرفق اخي فواتير.xlsm

تفضل يمكنك استخدام هذه المعادلة =B2*B4+(B3-1)*(B4*B2) معادله - 4.xlsx

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

Delete columns from column A to column G Select column A From Data tab select Text to Columns Select Delimited option and click Next button Check Space option and click Next button In Destination field select $B$1 cell And finally click Finish

الكود ده هيكنني هيكنني .....🤣

اتفضل تم حل المشكلة بالمرفق الاتى بالنسبة لـ كما قال لك استاذى الجليل ومعلمى القدير الاستاذ @أبو عبدالله الحلوانى -Waiting Role-.zip

نعم لم يعطي خطا في ال Debug

طبعا ممكن فانك واحدة بس ابشر

طيب جرب حمل هاد التطبيق https://drive.google.com/uc?id=1xHo6J688Vox4u9zwLzNbZUE1Mm1-9Vp4&export=download

أعانك الله استاذي الفاضل

وعليكم السلام استاذ نبيل وضعت لك مفتاح للسلك في جدول الوظيفة Database331n.accdb

تفضل العبقرى.xlsm

السلام عليكم ..التعديل هنا Range("B45:H191").Copy تفضل الملف vehicles Cost.xlsm

جزاك الله كل خير وجعله الله في ميزان حسناتك

السلام عليكم ..هذا حل مني..يتم حفظ صورة بي دي اف ---- علي برتيشن d Sub طباعه_عامة() ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ "d:\" & Format(Now, "- dd-mm-yyyy-") & Nombre & " " & QualityxlQualityStandard, _ IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Application.ScreenUpdating = True End Sub

السلام عليكم ورحمة الله وبركاته لحساب معدل النمو نطرح نتيجة الشهر السابق من نتيجة الشهر الحالي ونقسم الناتج على نتيجة الشهر السابق *100 هكذا والله أعلم وعليه فإنني أضع بين أيديكم الملف المرفق برجاء تجربته تقبل تحياتي العطرة =((F5*G5)-(A5*B5))/(A5*B5) حساب معدل التغيير.xlsx

فورم اكسل تهنئة بعيد الفطر المبارك بكلمات متحركة الملف اسفل الفيديو

رائع جزاك الله خير اخي حسين مامون

اخي الكريم أبو إيمان تفضل Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) On Error Resume Next Dim h1, h2, dt1, dt2, R1, R2 If Not Intersect(Target, Range("k2:k1000")) Is Nothing Then h2 = Target h1 = Format(Target.Offset(, -2), "dd-mm-yyyy") & " " & Format(Target.Offset(, -1), "hh:mm:ss") R1 = Format(DateAdd("h", h2, h1), "mm-dd-yyyy hh:mm:ss") R2 = Format(DateAdd("s", Target.Offset(, 1) * (60), R1), "DD-MM-yyyy hh:mm:ss") Target.Offset(, 2) = R2 End If If Target = Empty Then Target.Offset(, 1).Resize(, 2).ClearContents End Sub add hour to date.xlsm

أخى الفاضل يمكن استخدام الدالة MonthName لتحويل رقم الشهر إلى اسم الشهر

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

السلام عليكم اخ @lionheart جزاك الله الجنة و بارك الله بك الكود يعمل بشكل حيد شكرا جزيلا لك و بارك الله بك

السلام عليكم ورحمة الله تعالى وبركاته استاذ @حسام نصير ممكن تجربة المرفق الاتى اولا ولى عودة ان شاء الله وكان لى فى العمر بقية هذه تجربة جديدة فقط لقراءة النصوص العربية واعتقد انها تعتمد على وجود اللغة العربية ك Speech ضمن الويندوز لذا بعد تجربتكم رجاء أخبرنى هل تمت القراة بنجاح ام لا وفى حالة لم تتم القراءة رجاء أخبرنى بيانات الويندوز الذى تعمل عليه ؟ ومرفق ملف تطبيق يساعدك على تثبيت اللغة التى تريد قم بتجربته VoicesInstaller Test.accdb VoicesInstaller.zip

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

العفو اخى واتجدعن وربنا يوفقك

الله يبارك فيك اخى ابو عبدالله قام البشمهندس محمد طاهر بترقيه حسابى ده بناء ع حسابى السابق بعدما سالنى عن دمج الحسابين فطلبت منه عدم الدمج ووافق برحابه صدر شرفتم الموضوع اخوانى ابوعبدالله وابوجودى لانى اذا سالت ولم اجد اجابه اتوجه للمصدر الاساسى بسؤالى بمره سالت فى منتدى ميكروسوفت وتمت الاجابه 😀 اليك هذه الفديوهات ربنا يوفقك ويعينك واياكم اخوانى الافاضل 🌹 دى دوره لخالد السعدانى عن السى شارب وده مشروع بالسى شارب له برضه تقبلوا تحياتى ومرورى وتمنياتى لكم بالتوفيق والنجاح انا بقى مش هعرف ادور عليها فعلمنى اياها وخد فيا ثواب احبك الذى احببتنا فيه وانا احبكم كلكم فالله واحب بستطكم اخوانى واساتذتى بارك الله فيكم جميعا

ان كنت تريد نطق الرقم باللغة العربية فهذا سهل ان شاء الله سأحول لك في هذه الجزئية قريبا ان شاء الله اما عن التعامل مع الشاشة الرقمية فلم اجربه من قبل - ولكن اعقد ان التعامل معها مقارب للتعامل مع الميزان الالكتروني وقارئ جهاز البصمة و فتح درج الكاشير - يحتاج للتحكم بمنفذ الاتصال بالحاسب مع شاشة العرض لتمرير واستقبال الداتا ربما افادك في هذه الجزئية من هم اعلم مني بهذا المجال

طبعا ولا شك - ولكن لو كل واحد ترك علما لكون هنالك من هو اولي منه ببسطه للناس - ما تجرأ مبتدأ مثلي علي وضع جواب لسؤال. ثم وهنالك طريقة لحل المشكلات البرمجية المستعصية - يعرفها من طرق باب البرمجة - تسمي طريقة البطة ( مش هشرح وهسيبك تدور عليها) فاعتبر اخوانك المبتدأين أمثالي بطة جنابك لولا محبتكم بالله لما انبسطت معكم بالكلام وجزاكم الله خيرا

هذا الماء - عقبال الغموس (بلغة اهل البندر الطعام يعني) وجزاكم الله خيرا

عند الضغط انتهت المعاملة يتم نطق الرقم والتحويل الي الرقم التالي هل قمت بالتجربة يمكنك الضغط علي زر برنت اسكرين بلوحة المفاتيح عند ظهور رسالة الخطأ ولصقها بأحد برامج تعديل الصور كالرسام مثلا ثم اعادة رفعها - فالنسبالي انا نظري علي قدي والصورة مش واضحة كويس وجزاك الله خيرا

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

الحمد لله وفيك بارك الله اللهم آمين واياكم 🌹 بالتوفيق

نسخة أوفيس 2016 وكذلك 2019 وكذلك 365 جميعها رقم الإصدار الرسمي لها 16.0 ربما يفيدك هذا الرابط

صحيح اخي العزيز محمد حسن وجزاك الله خير على لمستك الجميله

السلام عليكم ورحمة الله وبركاته أحسنت أخي الكريم حراح أمة أفضل تحويل النطاق إلى جدول لتبقى المعادلة سارية مهما صار حجم الجدول =VLOOKUP(B4;الجدول6;4;0) معادله.xlsx

عليكم السلام ..اتفضل اخي معادله.xlsx

نعم هي الطريقة الافضل ، والكود اللي وضعته لك يضع الباركود من ضمن الحفظ ، وعليه يجب عليك ان تخفي الزر الخاص بالباركود 🙂 جعفر

الشكر لله اخي العزيز RaDwAn00 تفضل هذا المثال قد يكون فيه طلبك Database1.rar

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