ياسر خليل أبو البراء

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

نعم أخي الأكواد المقدمة تقوم بذلك .. هل جربت الأكواد؟

جرب الكود التالي عله يفي بالغرض Sub Test() Dim a As Variant Dim b As Variant Dim i As Long Dim x As Long a = Range("H12:H16").Value ReDim b(1 To UBound(a, 1) * 2, 1 To UBound(a, 2)) For i = LBound(b, 1) To UBound(b, 1) Step 2 x = x + 1 b(i, 1) = a(x, 1) Next i Range("N12").Resize(UBound(b, 1), UBound(b, 2)).Value = b End Sub أو كود أسهل من السابق Sub Demo() Dim a As Variant a = Split(Join(Application.Transpose(Range("H12:H16")), ",,"), ",") Range("N12").Resize(UBound(a) + 1).Value = Application.Transpose(a) End Sub

الحمد لله أن تم المطلوب على خير والحمد لله الذي بنعمته تتم الصالحات

وعليكم السلام جرب الكود التالي عله يفي بالغرض Sub Test() With Range("C2", Range("C" & Rows.Count).End(xlUp)) .NumberFormat = "@" .Value = Evaluate("index(text(" & .Address & ",""0000000000""),)") End With End Sub

هل عدد الأرقام ثابت أم أنه متغير .. وإذا كان المطلوب وضع صفر واحد فقط على يسار الرقم فيمكن استخدام معادلة بسيطة ="0" & A1 إذا لم تكن الإجابة كافية فيمكن إرفاق ملف يعبر عن المطلوب بدقة

جرب التالي لربما يفي بالغرض TextBox1=Format(TextBox1,"00")

يا أخي الموضوع ليس لي علم به وأحاول معك التوصل لما تريد .. أخبرتك أن الملف المسمى Question Set Editor يمكن من خلاله فتح وتحميل الملف MIL أو يمكنك من خلال نفس الملف إنشاء ملف جديد من خلال النقر على زر New ... وبهذا سيقوم بمسح ما هو موجود ويتيح لك إدخال بيانات جديدة ..فيمكنك وضع الأسئلة مع وضع الإجابة المطلوبة لها أي الإجابة الصحيحة .. هذا والله أعلم

نعم يمكن ذلك افتح الملف المسمى Question Set Editor ثم انقر على زر الأمر Load وحدد مكان الملف المطلوب وستجد أن البيانات الموجودة بالملف تم تحميلها .. ويمكنك التعديل عليها والنقر على زر حفظ

في الحقيقة أول مرة أرى هذا الامتداد ولكن استطعت ببساطة فتحه بواسطة Notepad ++ .. لذا أذا أردت إنشاء ملف مشابه يمكنك نسخ الملف والتعديل عليه ببساطة http://dotwhat.net/file/extension/mil/2016 تقبل تحياتي

أين ملف البوربوينت Question Preview.ppt؟

جزاكم الله خيراً إخواني وأحبابي في الله .. وبارك الله فيكم

استخدم دالة IF .. لترى إذا كانت الخلية في العمود تساوي الخلية في العمود ، وفي حالة تحقق الشرط يكتب 1 و في حالة عدم تحقق الشرط يكتب صفر .. الصيغة بسيطة حاول تنفذها بنفسك أو ارفق ملف وسيساعدك الأخوة في تنفيذ طلبك

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

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

وعليكم السلام أخي الكريم أبو عمار أهلاً بك في المنتدى ونورت بين إخوانك هلا أرفقت لنا الملف لنرى هذا الامتداد؟

نعم أخي العزيز أبو عمر .. !!

السلام عليكم أخي الكريم سيد جرب الكود التالي عله يفي بالغرض إن شاء الله Sub FillRandom() Dim lngSum As Long Dim i As Long Dim arrValues(1 To 13) As Double For i = 9 To Cells(Rows.Count, "B").End(xlUp).Row If Cells(i, "P").Value <> "" Then lngSum = Range("P" & i).Value Do arrValues(1) = Application.RandBetween(1, 10) arrValues(2) = 10 arrValues(3) = Application.RandBetween(1, 20) arrValues(4) = Application.Sum(arrValues(1), arrValues(2), arrValues(3)) arrValues(5) = Application.RandBetween(1, 10) arrValues(6) = 10 arrValues(7) = Application.RandBetween(1, 20) arrValues(8) = Application.Sum(arrValues(5), arrValues(6), arrValues(7)) arrValues(9) = Application.RandBetween(1, 10) arrValues(10) = 10 arrValues(11) = Application.RandBetween(1, 20) arrValues(12) = Application.Sum(arrValues(9), arrValues(10), arrValues(11)) Loop Until Application.Average(arrValues(4), arrValues(8), arrValues(12)) = lngSum arrValues(13) = Application.Sum(arrValues(4), arrValues(8), arrValues(12)) Range("C" & i).Resize(1, 13).Value = arrValues Range("R" & i).Value = Application.Sum(Range("P" & i).Value, Range("Q" & i).Value) End If Next i End Sub

وعليكم السلام أخي الكريم أبو عمران أهلاً بك في المنتدى ونورت بين إخوانك إن شاء الله أعمل على موضوعك غداً إذا لم يتدخل أحد الأخوة الكرام تقبل تحياتي

جرب الكود التالي عله يفي بالغرض Private Sub CommandButton4_Click() Dim i As Long Dim c As Long Dim x As Long Dim k As Long x = 11 For i = 1 To 8 c = c + (Me.Controls("TextBox" & i).Value * x) x = x - 1 Next i k = c Mod 100 UserForm2.TextBox10 = k UserForm1.Hide UserForm2.Show End Sub

لقد قام الأخ زيزو بتقديم حل ..هل جربته؟ ما هي المشكلة التي تواجهك الآن؟ حاول توضح المشكلة بعد تجربة الكود أعلاه

وجزيت خيراً أخي الكريم عبد الرحيم ..مشكور على مرورك العطر

جرب تحذف الجزء ده من الدالة المعرفة sTemp(i) Like "[أ-ي]*" Or

وعليكم السلام أخي أحمد جرب الدالة المعرفة التالية علها تفي بالغرض Function Initials(str As String) As String Dim sTemp() As String Dim i As Long sTemp = Split(str) For i = 0 To UBound(sTemp) If sTemp(i) Like "[أ-ي]*" Or UCase(sTemp(i)) Like "[A-Z]*" Then Initials = Trim(Initials & "" & UCase(Left(sTemp(i), 1))) End If Next i End Function لاستخدام الدالة في ورقة العمل =Initials(A1)

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