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

السلام عليكم ورحمة الله وبركاته إخواني الكرام أثناء تجوالي عثرت على هذه الدالة ، تقوم الدالة بعمل إدراج للصورة الدالة بالشكل التالي Function INSERTPICTURE(ByVal PictureFullName As String, Optional ByVal PicWidth As Single = 200, _ Optional ByVal PicHeight As Single = 150) Dim CellActive As Range Dim picPicture As Object Set CellActive = Application.Caller For Each picPicture In CellActive.Parent.Pictures If picPicture.TopLeftCell.Address = CellActive.Address Then picPicture.Delete Exit For End If Next Set picPicture = CellActive.Parent.Pictures.Insert(PictureFullName) With picPicture .Left = CellActive.Left + 1 .Top = CellActive.Top + 1 .Width = PicWidth .Height = PicHeight End With End Function لتنفيذ الدالة : قم بعمل مجلد مثلاً على البارتشن C وأعطه الاسم Pictures وضع صورة في هذا المجلد في الخلية قم بكتابة المعادلة بالشكل التالي: =INSERTPICTURE("C:\Pictures\Penguins.jpg") كما أنه يمكن إضافة أبعاد للصورة (العرض والارتفاع) بهذا الشكل =INSERTPICTURE("C:\Pictures\Penguins.jpg";200;800)

بارك الله فيك أبو حنين ، وجعل أعمالك في ميزان حسناتك يوم القيامة

الأخ الفاضل أبو حنين بارك الله فيك اسمح لي بتعقيب بسيط : ما فائدة السطرين التاليين R=True R=False حيث أنني لا أجد فائدة لهما ، حتى أنني قمت بحذفهما ، فعمل الكود بشكل جيد بدونهما

أستاذ رجب / اسمح لي أن أرفع قبعتي تحية لك (صحيح أنا مش بلبس قبعة ... بس دا للدلالة على مدى حبي لك) إني أحبك في الله

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

أخي الغالي ومعلمي الكبير يشرفني ردك على موضوعي اللغة بالفعل عربي في محرر الفيجوال بيسك ، ولا تزال المشكلة قائمة

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

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

بارك الله فيك أخي رجب

ارفق مثال أخي الكريم

بارك الله فيك على الشرح الوافي الكافي

بارك الله فيك أخي أحمد البحيري وجزيت خيرا على أعمالك الرائعة وجعله الله في ميزان حسناتك ويشرفني أن أكون مجاوراً لك!!!

جزيت خيرا يا عمرو بارك الله فيك

بارك الله فيكم وجزاكم الله خيراً الأخ السائل ارفق ملف للعمل عليه

أخي الحبيب ما هي النتائج المتوقعة من المعادلات .. إذ أني لاحظت أن الخلية D6 مثلا بها المعادلة بهذا الشكل ='Master 2012'!C5:C20 هذه المعادلة غير منطقية أرجو توضيح المطلوب بشكل أكثر وضوحاً

لو أمكن ارفق الملف المراد العمل عليه والبرنامج لنفهم المطلوب جيداً

أخي الفاضل ::: ما الضرر في التعديل على المعادلة ؟؟؟ أنت ستقوم بعمل المعادلة في كل عمود مرة واحدة ثم تقوم بنسخ المعادلة إلى باقي الخلايا ببساطة لا أعتقد أن الأمر فيه معاناة

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

بارك الله فيك يا أبو نصار ، وجعل أعمالك في ميزان حسناتك يوم القيامة

بارك الله فيك أخ يوسف الأخ السائل : هل تم حل مشكلتك أم أنها ما زالت قائمة؟

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

الملف المرفق لم يتم تحميله جيداً أرجو إعادة رفعه

بسم الله ما شاء الله يا أبو حنين بارك الله فيك

جرب الكود بهذا الشكل قمت بإضافة بسيطة... ممكن أعرف ما هي رسالة الخطأ التي تظهر لك عندما تقوم بتشغيله على أوفيس 2003 لأني بستخدم 2007؟ Private Sub Worksheet_Calculate() Dim c As Range Dim MyRng As Range, V As Shape Dim G As Integer, R As Integer, d As Integer '================================================ G = 2 ' ÚãæÏ ÑÞã ÇáÌáæÓ R = 15 ' ÕÝ ÇáÏÑÌÇÊ Set MyRng = Range("e16:p44") ' äØÇÞ ÇáÎáÇíÇ ÇáÐí ÊÑíÏ ÇÖÇÝÉ ÇáÏæÇÆÑ ÝíåÇ '================================================ Application.ScreenUpdating = False Application.EnableEvents = False '==============ÍÐÝ ÇáÏæÇÆÑ ÇáÓÇÈÞÉ==================== For Each V In ActiveSheet.Shapes If V.Top = Rows(16).Top + 1 Or V.Top = Rows(30).Top + 1 Or V.Top = Rows(44).Top + 1 Then V.Delete Next '================================================ For Each c In MyRng If Cells(c.Row, G) = 0 Or Cells(c.Row, G) = "" Then GoTo 1 If IsNumeric(Cells(R, c.Column)) And Not IsEmpty(Cells(R, c.Column)) And (c.Value < Cells(R, c.Column) Or c.Value = "Û") And c.Value <> "" Then Set V = ActiveSheet.Shapes.AddShape(msoShapeOval, c.Left + 1, c.Top + 1, c.Width - 2, c.Height - 2) V.Fill.Visible = msoFalse V.Line.ForeColor.SchemeColor = 10 V.Line.Weight = 2 d = d + 1 End If 1 Next Application.EnableEvents = True Application.ScreenUpdating = True End Sub

الأخ الكريم يوسف حاول توضيح طلبك بتفصيل أكثر