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

Tarek Syrian · أكتوبر 3, 2018

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

عندي طلب صغير ومابظن انه صعب على العمالقة ... بدي كود 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 · أكتوبر 3, 2018

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

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

**طارق محمود** · أكتوبر 4, 2018

السلام عليكم

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

تفضل أخي طارق بالملف المرفق المساحة الصفراء (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