أ / محمد صالح

لعل هذا هو المطلوب تم استعمال الخلية T1 لاختيار طريقة الطباعة فردي أو جماعي تغيير كود الاجراء text إلى Sub text() printtype = N.Range("t1") If printtype = "فردي" Then x = InputBox("من فضلك ادخل الرقم القومى مع تحياتى اشرف صبور ") N.Range("t2") = x On Error GoTo mm i = Application.WorksheetFunction.Match(N.Range("t2"), DB.Range("c:c"), 0) Call filldata(i) N.PrintPreview Call cler Exit Sub mm: MsgBox "الرقم القومى غير موجود مع تحياتى اشرف صبور" Else lr = DB.Cells(Rows.Count, 3).End(3).Row For r = 13 To lr filldata (r) ActiveSheet.PrintOut Next r Call cler End If End Sub وفي حالة اختيار جماعية يتم طباعة الأرقام من الصف 13 إلى آخر صف مكتوب فيه lr = DB.Cells(Rows.Count, 3).End(3).Row For r = 13 To lr وحتى لا نكرر كود تعبئة الخلايا تم فصل كود التعبئة في إجراء منفصل مع تمرير رقم الصف المراد طباعته إليه Sub filldata(i) N.Range("c7") = DB.Cells(i, "g") N.Range("c8") = DB.Cells(i, "ci") N.Range("g7") = DB.Cells(i, "b") N.Range("g8") = DB.Cells(i, "c") N.Range("c9") = DB.Cells(i, "f") N.Range("c13") = DB.Cells(i, "i") N.Range("e13") = DB.Cells(i, "j") N.Range("b16") = DB.Cells(i, "l") N.Range("c16") = DB.Cells(i, "m") N.Range("d16") = DB.Cells(i, "n") N.Range("b22") = DB.Cells(i, "af") N.Range("b23") = DB.Cells(i, "ao") N.Range("b24") = DB.Cells(i, "ax") N.Range("b25") = DB.Cells(i, "bg") N.Range("d20") = DB.Cells(i, "q") N.Range("d21") = DB.Cells(i, "y") N.Range("d22") = DB.Cells(i, "ah") N.Range("d23") = DB.Cells(i, "aq") N.Range("d24") = DB.Cells(i, "az") N.Range("d25") = DB.Cells(i, "bi") N.Range("d26") = DB.Cells(i, "bq") N.Range("d27") = DB.Cells(i, "by") N.Range("d29") = DB.Cells(i, "cf") N.Range("g20") = DB.Cells(i, "w") N.Range("g21") = DB.Cells(i, "ae") N.Range("g22") = DB.Cells(i, "an") N.Range("g23") = DB.Cells(i, "aw") N.Range("g24") = DB.Cells(i, "bf") N.Range("g25") = DB.Cells(i, "bo") N.Range("g26") = DB.Cells(i, "bw") N.Range("g27") = DB.Cells(i, "ce") N.Range("g28") = DB.Cells(i, "k") N.Range("f29") = DB.Cells(i, "cg") N.Range("e20") = DB.Cells(i, "s") N.Range("e21") = DB.Cells(i, "aa") N.Range("e22") = DB.Cells(i, "aj") N.Range("e23") = DB.Cells(i, "as") N.Range("e24") = DB.Cells(i, "bb") N.Range("e25") = DB.Cells(i, "bk") N.Range("e26") = DB.Cells(i, "bs") N.Range("e27") = DB.Cells(i, "ca") N.Range("f20") = DB.Cells(i, "t") N.Range("f21") = DB.Cells(i, "ab") N.Range("f22") = DB.Cells(i, "ak") N.Range("f23") = DB.Cells(i, "at") N.Range("f24") = DB.Cells(i, "bc") N.Range("f25") = DB.Cells(i, "bl") N.Range("f26") = DB.Cells(i, "bt") N.Range("f27") = DB.Cells(i, "cb") N.Range("c31") = DB.Cells(i, "cl") N.Range("g31") = DB.Cells(i, "cm") End Sub وأنصح دائما بدراسة وفهم الكود ومتغيراته وكائناته جيدا قبل تطبيقه على شيت آخر بالتوفيق طباعة فردي أو جماعي.xlsm

حسب فهمي للمطلوب : وهو تحويل الأرقام الموجودة في ورقة1 من D4:L65 إلى ما يقابلها من أسماء في نفس المدى ووضغها في شيت ورقة2 . مع العلم أن الأسماء سواء في ورقة1 أو ورقة2 اعتمادا على رقم المسلسل للوصول للمطلوب بإذن الله يمكنك: * حذف المحتويات للخلايا D4:L65 * حذف تنسيقات لون الخلفية ولن النص في نفس النطاق * استعمال المعادلة التالية في الخلية D4 =IFERROR(VLOOKUP(ورقة1!D4:L65,$B$4:$C$65,2,0),"ح") * إضافة تنسيق شرطي للخلية D4 باستعمال المعادلة التالية =COUNTIF($D4:$L4,D4)>1 ويطبق على المدى =$D$4:$L$65 ولا أدري ما سبب الصف الفارغ بين مسلسل 31 و 32 بالتوفيق

بارك الله لك معلومات قيمة

ما دمت مصرا على تجاهل الخطأ في تنظيم البيانات واختلاف عدد السطور في كل عمود عن غيره في نفس الصف هذا الكود يبحث عن كلمة بكالوريوس ويجلب البيانات الموجودة في نفس السطر من جميع الأعمدة ويضعها في الأعمدة بداية من H:M مع تجاهل أي خطأ يقابله لذلك أنا شخصيا لست متأكدا بنسبة 100% من صحة النتائج لأن البيانات غير صحيحة من البداية Sub MasSplitText() Dim MyArray() As String, newcol As Long, i As Variant, lr As Long On Error Resume Next lr = Cells(Rows.Count, 1).End(3).Row Range("h2:m" & lr).ClearContents For c = 1 To 6 For rw = 2 To lr MyArray = Split(Cells(rw, 2), Chr(10)) newcol = c + 7 For i = 0 To UBound(MyArray) If MyArray(i) = "بكالوريوس" Then Cells(rw, newcol) = Split(Cells(rw, c), Chr(10))(i) Next i Next rw Next c MsgBox "Done by mr-mas.com" End Sub بالتوفيق

جميعا بإذن الله

يمكنك وضع هذه المعادلة في الخلية A6 ثم سحب المعادلة لأسفل =IFERROR(INDEX('date out'!B$1:I$100,SMALL(IF('date out'!$A$1:$A$100=$A$1,ROW('date out'!$A$1:$A$100)),ROW()-5),{1,2,3,4,5,6,7,8}),"") وهذا ملفك إن كنت لا تعلم كيف تضيف المعادلة مثل بعض الأعضاء بالتوفيق Copy of BİLDİRİM LİSTESİ.xlsx

حسب فهمي للمطلوب هذه محاولة فقط يلزم كتابة الدرجة ويتم الحصول على كل الخلايا بالتوفيق C_2.xlsx

على أي أساس يتم الضرب في أحد هذه الخلايا؟ ما الشرط؟

أعتقد لا يوجد مشكلة في كود زر الترحيل ولكن يجب الانتباه إلى أنه يعمل على الشيت النشط Set ws = ActiveSheet بالتوفيق

عليكم السلام ورحمة الله وبركاته يمكنك وضع هذه المعادلة في الخلية G5 =EDATE(F5,COUNT(I5:R5)-1) ثم سحبها لأسفل وهي لعد الشهور المسجلة في I5:R5 وإضافتها على تاريخ بداية الاشتراك إن شاء يكون المطلوب بالتوفيق

جميعا بإذن الله

جميعا بإذن الله

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

اهلا وسهلا نفع الله بكم

الشكر لله وفقنا الله جميعا لكل خير

جميعا بإذن الله تعالى

بعد إذن جميع الأصدقاء المشاركين في هذا الموضوع الرائع هذا جهدي المتواضع لتحميل الملفات من جوجل درايف بنفس الاسم والامتداد فقط تحتاج رابط الملف كاملا وأن يكون الملف عاما (مشاركا مع الجميع) الكود يعالج مشكلة أسماء الملفات العربية صالح للنواتين 32بت وكذلك 64بت يعمل في كل التطبيقات التي تستعمل vba يوضع هذا الكود في موديول جديد Sub DownloadFromGD(GDriveURL As String) Dim myURL As String Dim FileID As String Dim xmlhttp As Object Dim name0 As Variant Dim oStream As Object FileID = Split(Split(GDriveURL, "/d/")(1), "/")(0) myURL = "http://drive.google.com/u/0/uc?id=" & FileID & "&export=download" Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP") xmlhttp.Open "GET", myURL, False xmlhttp.Send name0 = DECODEURL(xmlhttp.getResponseHeader("Content-Disposition")) If name0 = "" Then MsgBox "الملف غير موجود في الموقع" Exit Sub End If name0 = Split(name0, "*=UTF-8''")(1) 'split after *=UTF-8'' to get utf8 names If xmlhttp.Status = 200 Then Set oStream = CreateObject("ADODB.Stream") oStream.Open oStream.Type = 1 oStream.Write xmlhttp.responseBody oStream.SaveToFile CurrentProject.Path & "\" & name0, 2 ' 1 = no overwrite, 2 = overwrite oStream.Close End If Set xmlhttp = Nothing Set Stream = Nothing MsgBox "تم تحميل الملف في نفس مسار البرنامج باسم: " & name0 End Sub Function DECODEURL(varText As Variant) Static objHtmlfile As Object If objHtmlfile Is Nothing Then Set objHtmlfile = CreateObject("htmlfile") objHtmlfile.parentWindow.execScript "function decode(s) {return decodeURIComponent(s)}", "jscript" End If DECODEURL = objHtmlfile.parentWindow.decode(varText) End Function طريقة استخدام الكود مثل السطر المكتوب في الإجراء test أو يمكن وضعه عند الضغط على زر مثلا ويتكون هذا السطر من كتابة اسم الاجراء DpwnloadFromGD ثم رابط الملف المراد تحميله بين علامتي تنصيص ويمكن استخدام قيمة مربع النص بدلا من تثبيت رابط الموقع Sub test() DownloadFromGD "https://drive.google.com/file/d/18jrvTxgR1QTzwm8YaJHIvsdOmqj02L2x/view" End Sub ولا تنسوني من صالح دعائكم بالتوفيق للجميع

عليكم السلام سيتم الجمع بصورة تلقائية إذا تم إدراج الصفوف الجديدة قبل الصف الأخير (الذي قبل الإجمالي مباشرة) ولكي يتم ذلك نحدد الصف الثالث ثم نضغط كلك يمين ثم نختار إدراج insert وهكذا في كل إدراج بالتوفيق

بارك الله فيكم

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

لقد اخبرتك بما اعتقد انه يفيدك ولكن ربما لم يتم استيعابه جيدا ولا ادري ما المشكلة؟ الرابط يفتح إصدار سطح المكتب كما هو مكتوب في الرابط وإذا كان في بدايته m سيفتح إصدار الموبايل كما تم الشرح في أول مشاركة لي

ما شاء الله رائع كعادتك صديقي

عليكم السلام ورحمة الله وبركاته كل خلية يوجد بها أكثر من بيان بينهما سطر جديد داخل نفس الخلية وبعض الخلايا تحتوي على سطرين و بعضها يحتوي على 3 سطور وبعضها يحتوي على 4 سطور وبعضها يحتوي على 5 سطور ويوجد تقريبا 6 سطور أيضا و بعضها يحتوي على سطر واحد فقط هل المطلوب جلب بيانات آخر سطر داخل الخلية يعني السطر الثاني في حالة وجود 2 والثالث في حالة وجود 3 وهكذا ؟؟؟ مع العلم ليست كل الخلايا في نفس الصف منضبطة في عدد السطور فمثلا الصف 17 أول 4 أعمدة يوجد في الخلية 4 سطور وفي العمودين 5 و 6 في نفس الصف نجد الخلية بها 5 سطور وهذا الاضطراب لا يسمح بضبط الأمر فأول خطوة للحصول على المطلوب هو ضبط عدد السطور في كل صف بالتوفيق

الرابط الموجود في الحلية هو Mark Zuckerberg مرتبط بهذا العنوان https://www.facebook.com/zuck?__cft__[0]=AZXlg8B7EB-A_janTQ24MXbO6O1Hb-QgGF5Cr3gwhFX7gitPtdC7-iHeelnR7MI5YNDwu1-lqeTH1nQA7QiBm95wTU6uubcdaN2PQO1ACnnMAylE3u-iMm0U-ZmXKwy5LROzsgXi60fwx6BHoItpu7b7&__tn__=-UC%2CP-R والأفضل أن يتم نسخ الرابط إلى هذا الجزء فقط https://www.facebook.com/zuck وعند الضغط على الرابط من الكمبيوتر تم فتح إصدار سطح المكتب فقط ولا يفتح نافذة الموبايل بالتوفيق

الشكر لله الذي وفقنا لهذا 👍🌹👍