تحويل التعليقات إلى نصوص

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

السلام عليكم

مرحبا بإخواني الأحباب في منتدانا الغالي

كيف حالكم جميعاً ؟؟

أتمنى أن تكونوا بصحة جيدة وفأن تكونوا في أحسن حال

موضوع جديد من نوعه ربما لي وليس لغيري

إذا كانت هناك الخلايا A1:A10 مثلاً بها تعليقات وأردت نسخ التعليقات إلى الخلايا B1:B10

بحيث تكون التعليقات نصا في الخلايا في العمود B

أخوكم أبو البراء

تم تعديل يناير 6, 2010 بواسطه YasserKhalil

[يحيى حسين]

أخي يا سر

كيف حالك

جرب هذا الكود

 Sub GetMyComments()

	For Each cell In Range("b1:b10")

    	cell.Value = cell.Offset(, -1).Comment.Text

	Next cell

End Sub

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

السلام عليكم

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

مع مسح ما في العمود B

بمثل هذا الكود

Sub KH_START()

Dim MyCell As Range

Dim R As Integer

Set MyCell = Range("A1:B10")

With MyCell

    .Columns(2).ClearContents

    For R = 1 To .Rows.Count

        If Not .Range("A" & R).Comment Is Nothing Then

            .Range("B" & R).Value = .Range("A" & R).Comment.Text

        End If

    Next R

End With

End Sub

[أبوعبد الله]

أخي العزيز / أبو البراء

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

تحياتي

أبو عبدالله

نسخ ولصق نص التعليقات.rar

تم تعديل يناير 6, 2010 بواسطه أبو عبد الله

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

حلول أكثر من رائعة

شكري الخالص لكل أعضاء المنتدى وجهابذته

إليكم دالة متواضعة نقلتها لكم من إحدى المواقعا الأجنبية

أخوكم أبو البراء

Test.rar

[احمد فضيله]

جزاكم الله خيرا

لكن هناك تعليق ممكن الاخ ابو البراء بعد اذنه يشوف الكود ما بيشتغلش ليه

و شكرا

[احمد فضيله]

استفسار للاستاذ / أبو عبدالله

لو انا حبيت اخد copy من comments فى شيت تاني الكود بيوقف

ارجو الافاده

و جزاك الله كل خير

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

السلام عليكم

لو انا حبيت اخد copy من comments فى شيت تاني الكود بيوقف

ارجو الافاده

ضيف في الكود قبل السطر:

rngTarget.Activate

السطر التالي:

rngTarget.Worksheet.Activate

الكود بعد التعديل:

Sub CopyPaste_All_Comments()

Dim aComment()

Dim rngTarget As Range

Dim rngSource As Range

        On Error Resume Next

        Set rngSource = Application.InputBox("اختر النطاق المطلوب نسخ التعليقات منه", Type:=8)

        On Error GoTo 0

        If rngSource Is Nothing Then Exit Sub


For Each cell In rngSource

    Set xComment = cell.Comment

    If Not xComment Is Nothing Then

        x = x + 1

        ReDim Preserve aComment(x)

        aComment(x) = cell.Comment.Text

    End If

Next cell

        On Error Resume Next

        Set rngTarget = Application.InputBox("اختر أول خلية في النطاق المطلوب وضع التعليقات فيه", Type:=8)

        On Error GoTo 0

        If rngTarget Is Nothing Then Exit Sub

rngTarget.Worksheet.Activate

rngTarget.Activate

For x = 1 To UBound(aComment)

    ActiveCell.Offset(x - 1, 0).FormulaR1C1 = aComment(x)

Next


End Sub

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

إليكم إخواني هذا الملف الذي يقوم بتجميع كل التعليقات

هدية من البراء لمنتدى أوفيسنا

CreateCommentsSummary.rar

[احمد فضيله]

بارك الله فيكم

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

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