" طلب " إضافة كومنت تلقائياً عند ملئ خلاية معينة

[Tarek Syrian]

السلام عليكم اخواني 

عندي طلب صغير ومابظن انه صعب على العمالقة ... بدي كود vba بمجرد ما خلية من خلاية عامود معين تمتلئ يظهر إضافة كومنت تلقائياً 

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

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

Sub Jacks_SpecialCommentBox()

' Jack Creates the comment.
ActiveCell.AddComment ("")
' Can have user name in top left by adding name between ""
ActiveCell.Comment.Visible = True
ActiveCell.Comment.Shape.Select
With Selection
'Jack Chooses the CLOUD AutoShape from Drawing T/Bar.
.ShapeRange.AutoShapeType = _
msoShapeLineCallout3

'Jack decides to have col(u)rs in the cloud.
.ShapeRange.Fill.PresetGradient _
msoGradientHorizontal, 1, _
msoGradientHorizon

' Jack decides to have BOLD and Italics, felt like it!
.Font.Name = "GE SS Two Bold"
.Font.FontStyle = "Bold Italic"
.Font.Size = 18
'Jack moves and resizes the cloud - wanted to!
Selection.ShapeRange.Adjustments.Item(1) = -2
Selection.ShapeRange.ScaleWidth 0.8, msoFalse, msoScaleFromTopright

End With
End Sub

وشكراً 

[Emad Sabry]

ارفع ملف وحط به بعض البيانات بدون الكود وقول طلبك يعنى مثلا خلية A1 لو ظهر فيها بيانات عاوز الكومنت يكون ايه 

تم تعديل أكتوبر 3, 2018 بواسطه Emad Sabry

[طارق محمود]

السلام عليكم

بعد إذن أخونا عماد

تفضل أخي طارق بالملف المرفق المساحة الصفراء (H9:H17) إذا فيها خلايا ليست فارغة سيضيف لها كومنت "XX"
الكومنت يختفي بعد الإضافة

 

الكود في حدث تغيير الإختيار للورقة

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

 

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error Resume Next
If Not Intersect(Target, [H9:H17]) Is Nothing Then Exit Sub
For Each c In [H9:H17]
    If IsEmpty(c) = True Then c.ClearComments: GoTo 10

    c.AddComment ("XX")
    c.Comment.Visible = False
10
   Next c
End Sub

 

Add comment.xlsm

[Ali Mohamed Ali]

احسنت استاذى الكريم بارك الله فيك

 

[Tarek Syrian]

ربي يسعدك ويحفظك اخي طارق هاد هو المطلوب الله يجزيك الخير 🌹