كود يقوم بالتعديل فى تعليق خلية وفقاً لنطاق معين

[عادل ابوزيد]

الاساتذة الكرام بعد تقديم وافر التحية والاحترام

المطلوب كود يقوم بتعديل محتويات التعليق الموجود بالخلية e6

وفقاً للتعديل فى النطاق الموجود بالشيت رقم 1 والمسمى باسم بحيث محتوى التعليق يساوى محتوى النطاق على ان يفصل بين الاسماء علامة +

حيث ارغب فى الاستعانة به فى ملفى وسبق ان تم الاستعانة بملف للعلامة عبد الله باقشير بالرابط

http://www.officena.net/ib/index.php?showtopic=43782

ويلزم هذه الكود ليكتمل العمل بملفى حيث انه مرتبطان ببعض

التعديل فى تعليق خلية وفقاً لمحتويات نطاق.rar

تم تعديل أغسطس 10, 2013 بواسطه عادل ابوزيد

[عبدالله باقشير]

السلام عليكم

 

اذا كنت تريد استخدام اسم نطاق للقائمة بالنسبة لنموذج الادخال

قمنا بتعديل بسيط ليتناسب مع طلبك

المرفق 2003

فورم ادخال و تعديل مرن باستخدام اسم نطاق للقائمة.rar

 

[عادل ابوزيد]

استاذى الفاضل

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

ولكن هل يمكن ان تدلنى على طريق التنفيذ لاقوم بتنفيذه على البرنامج الخاص بى

ماذا افعل او ما هو التعديل على الرغم اننى قمت بتسمية النطاق ووضعت الاسم فى التعليق ولم يفلح الامر حيث ظهر فى القائمة اسم النطاق وليس محتويات النطاق

كما قمت باستبدال الجزء الخاص بالدالة فى الملف القديم بالملف الخاص بى ولم يفلح الامر

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

[الـعيدروس]

السلام عليكم

 

بعد اذن استاذنا الكبير عبدالله باقشير

هذا تعديل بسيط لكود حدث الورقة

Private Sub Worksheet_Change(ByVal Target As Range)
Columns("A:az").AutoFit
Dim rng As Range
Set Fn = Application.WorksheetFunction
Set rng = Range([a1], [a1].End(xlToRight))
CountCol = rng.Columns.Count
DelAllNames
For x = 1 To CountCol
    EndRow = Cells(Rows.Count, x).End(xlUp).Row
    If EndRow = 1 Then EndRow = EndRow + 1
    On Error Resume Next
    Range(rng(x).Offset(1), Cells(EndRow, x)).Name = Fn.Substitute(rng(x), " ", "_")
Next
If Not Intersect(Target, [A2:A1500]) Is Nothing Then
    For Each Cn In Target
      Set Rn = Sheet2.[E6]
         Rn.ClearNotes
         Rn.AddComment
            Ci = Application.CountA(Columns(Target.Column)) - 1
            Tn = ""
            If Ci > 0 Then
               For Each C In Cells(2, 1).Resize(Ci)
                  Tn = Tn & C & IIf(Rw = 2, "", "+") & IIf(Rw = 2, Chr(10), "")
                   If Rw = 3 Then Rw = 1
                  Rw = Rw + 1
               Next C
            End If
         Rn.Comment.Text Text:=Tn
         Rn.Comment.Shape.TextFrame.AutoSize = True
     Next Cn
End If
End Sub 

[عبدالله باقشير]

استاذى الفاضل

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

ولكن هل يمكن ان تدلنى على طريق التنفيذ لاقوم بتنفيذه على البرنامج الخاص بى

ماذا افعل او ما هو التعديل على الرغم اننى قمت بتسمية النطاق ووضعت الاسم فى التعليق ولم يفلح الامر حيث ظهر فى القائمة اسم النطاق وليس محتويات النطاق

كما قمت باستبدال الجزء الخاص بالدالة فى الملف القديم بالملف الخاص بى ولم يفلح الامر

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

 

ايضا استبدل الكود   UserForm_Activate

في ملفي المرفق  الى ملفك

لان هناك سطر من الكود تم التعديل فيه

 

وهو التالي:

.List = Range(MyList).Value

جرب واشعرنا بالنتيجة

[عادل ابوزيد]

استاذى الفاضل

اعتذر بشدة لجهلى حيث اننى لم اوفق

ارجو المعذرة ومزيد من الشرح

البرنامج_مع_كود.rar

تم تعديل أغسطس 11, 2013 بواسطه عادل ابوزيد

[عبدالله باقشير]

السلام عليكم

 

تعديلك صحيح على فورم UserForm2

 

لكن انت لا تشتغل على هذا الفورم وانما تعمل على فورم UFormChang

 

تم استبدال الفورم الذي تم التعديل عليه

 

البرنامج_مع_كود.rar

[عادل ابوزيد]

استاذنا العزيز القدير

جزاك الله كل الخير ولا املك غير الدعاء فى ظهر الغيب

اللهم احسن اليه كما يحسن الينا اللهم امين

[عادل ابوزيد]

الاستاذ العزيز عباد

ما اروع ابداعاتك ما شاء الله عليها

اللهم احسن اليه كما يحسن علينا اللهم امين