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

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

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

وعليكم السلام إن شاء الله يساعدك أحد الأخوة في طلبك ولكن لي سؤال ما الفائدة من هذا الأمر (من باب الفضول لا أكثر)

أخي الكريم أحمد الكود وأقصد أي كود يمكن التعديل عليه بما يتناسب مع ملفك .. قم بالتغيير ولا تخشى التعديل (حاول وافشل يكفيك شرف المحاولة) حاول دائماُ في الحلول التي توضع أن تدرسها وتفهمها وتهضمها بشكل جيد لكي تستفيد منها وتستطيع التعديل عليها بنفسك وليكن شعارك فيد واستفيد ، وانقل المعلومة لغيرك ليعم الخير على الجميع تقبل تحياتي

جرب الكود التالي (تم العمل على الملف الأصلي في المشاركة الأولى بعد فهم المطلوب) Sub Test() Dim rngCom As Range Dim cCom As Range Dim strCom As String Dim x As Variant Dim strDay As String Dim y As Variant Dim strDate As String Dim strDayNew As String Dim z As Variant Application.ScreenUpdating = False With ActiveSheet On Error Resume Next Set rngCom = .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeComments) On Error GoTo 0 If rngCom Is Nothing Then MsgBox "No Comments Found", vbExclamation Exit Sub End If For Each cCom In rngCom strCom = cCom.Comment.Text x = Split(Application.WorksheetFunction.Trim(strCom), vbLf) strDay = x(1) y = Split(strDay) strDay = Trim(y(2)) strDate = x(2) z = Split(strDate) strDayNew = Application.Text(Replace(z(0), ".", "/"), "[$-409]dddd") If strDayNew <> strDay Then cCom.Comment.Text Replace(strCom, strDay, strDayNew) End If Next cCom End With Application.ScreenUpdating = True End Sub

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

شاهد الفيديو على الرابط التالي .. https://we.tl/3DcJmZrpOz

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

وعليكم السلام أول خطأ في الملف المرفق أنك غيرت الامتداد للملف المسمى Zayed Allaw Cairo وكان امتداده xlsx .. لاحظت الآن بعد تحميل الملف أن الامتداد بصيغة أخرى xlsb لذا بشكل مبدئي يجب تغيير السطر التالي ليتناسب مع العمل الجديد ....... Const strInput = "Zayed Allaw Cairo.xlsx" سأتناول نقطة واحدة في كل مرة لتتعلم كيفية تصحيح الخطأ بنفسك .. في انتظار التعديل والتجريب ، ولو فيه أي مشكلة جديدة أعلمنا بها تقبل تحياتي

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

أنا أرسلت إليك ملف على الخاص قم بإرفاقه في الموضوع ..هل جربت الملف المرفق ؟؟ لأنني جربته ويعمل بشكل جيد جداً يبدو ان هناك حلقة فارغة في الأمر راجع المحادثة وشوف الملف المرفق وجربه مرة أخرى ضع المجلد xxx في نفس مسار الملف

أخي الكريم بارك الله فيك قمت بالضغط على Alt + F8 ستظهر لك نافذة فيها أسماء الماكروهات الموجودة لديك اختر الماكرو وانقر على Run إذا كانت المشكلة قائمة قم بإرفاق الملف ها هنا ليساعدك الأخوة الكرام بالمنتدى تقبل تحياتي

بارك الله فيك أخي العزيز أبو حنين وجزيت خيراً على مرورك العطر

الحمد لله الذي بنعمته تتم الصالحات مشكور على كلماتك الطيبة تقبل تحياتي

أخي الكريم أبو حمزة جرب الكود بالشكل التالي Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim myPath As String, fullImagePath As String myPath = ThisWorkbook.Path & "\pic\" fullImagePath = myPath + [B1] If Target.Address = "$B$1" Then If Dir(fullImagePath & "1.JPG") <> "" Then Image1.Picture = LoadPicture(fullImagePath & "1.JPG") Else Image1.Picture = LoadPicture(myPath & "NO.JPG") End If '========================================================= If Dir(fullImagePath & "2.JPG") <> "" Then Image2.Picture = LoadPicture(fullImagePath & "2.JPG") Else Image2.Picture = LoadPicture(myPath & "NO.JPG") End If '========================================================= If Dir(fullImagePath & "3.JPG") <> "" Then Image3.Picture = LoadPicture(fullImagePath & "3.JPG") Else Image3.Picture = LoadPicture(myPath & "NO.JPG") End If '========================================================= If Dir(fullImagePath & "4.JPG") <> "" Then Image4.Picture = LoadPicture(fullImagePath & "4.JPG") Else Image4.Picture = LoadPicture(myPath & "NO.JPG") End If End If End Sub

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

تسلم أخي الغالي أبو عيد على الشرح الممتاز الذي يفوق الوصف .. السهل الممتنع أعتقد أصبحت الصورة واضحة الآن لاستخدام دالة CHOOSE (وهي تعني باللغة الإنجليزية "اختيار" ، ومن اسمها تعرف المقصد من استخدامها) تقبلوا تحياتي

وعليكم السلام مشكور على كلماتك الطيبة أخي وحبيبي في الله محمود الشريف الأخ أبو حنين أعطيتك الكود وكان يجب تغيير ما يلزم حسب المعطيات (حاول دراسة الكود ستجد أن الموضوع بسيط .. يقتصر الآن فقط على الإشارة لكل مصنف (من وإلى ) وعلى حسب المعطيات التي تفضلت بها جرب الكود التالي (يوضع الكود في موديول عادي في المصنف المسمى TIME SHEET TAREK EK 2017) Sub zayed_allaw() Dim wbk As Workbook Const strInput = "Zayed Allaw Cairo.xlsx" Application.ScreenUpdating = False ThisWorkbook.Sheets("Zayed Allaw").Range("A1:X19").Copy On Error Resume Next Set wbk = Workbooks(strInput) If wbk Is Nothing Then Set wbk = Workbooks.Open(Filename:=ThisWorkbook.Path & "\" & strInput) If wbk Is Nothing Then MsgBox strInput & " Not Found!", vbCritical End If End If wbk.Sheets("Zayed Allaw").Range("A1").PasteSpecial xlPasteValues ThisWorkbook.Sheets("Zayed Allaw").Activate Range("A1").Select Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

وعليكم السلام أعتقد أنك قمت بالتواصل معي على الفيس وأعطيتك ملف مرفق فيه كود .. هل جربت الكود ؟ ما هي النتائج أو المشكلات التي ظهرت لديك؟ المزيد من التوضيح للمشكلة يساهم في حل المشكلة أخي الكريم

بارك الله فيك أخي الكريم أبو حمادة ومشكور على دعائك الطيب المبارك ، وإن شاء الله لك بمثله وزيادة تقبل تحياتي

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

أخي الكريم أبو الحسن لابد من معرفة قواعد وأساسيات التعامل مع محرر الأكواد في الموضوع التالي فصلت الأساسيات لكل مبتديء في هذا المجال أرجو أن يفيدك إن شاء الله (وستجد الحل في الموضوع .. اكتشف بنفسك) http://laernoffice.com/2016/04/16/بداية-الطريق-لإنقاذ-الغريق-أساسيات-ال/

وجزيت خيراً الموضوع بسيط ولابد من تعلم الأساسيات .. يوجد هذا السطر للتعامل مع ورقة العمل النشطة With ActiveSheet إذا أردت التعامل مع ورقة العمل المسماة add على سبيل المثال ، ستقوم بتغيير كلمة ActiveSheet إلى التالي With Sheets("aadd")

وعليكم السلام جرب الكود التالي Option Explicit Private Sub CommandButton1_Click() Dim x As Variant Dim y As Long With ActiveSheet x = TextBox1.Value y = (.HPageBreaks.Count + 1) * (.VPageBreaks.Count + 1) If x = "" Or Not IsNumeric(x) Or x > y Then MsgBox "Enter Valid Value", vbExclamation: Exit Sub .PrintOut From:=1, To:=x End With End Sub لاحظ أنه عندما يكون الموضوع مباشر والطلب واحد ومحدد تجد استجاية أفضل (راجع الموضوعات التي لم تجد فيها استجابة ستجد أن هناك تشتت وأكثر من طلب) أحببت أن أنوه لك لكي ينتبه الجميع للأمر ، فالله يعلم أني أريد المصلحة والمنفعة للجميع وفقنا الله وإياكم لكل خير