طلب جمع بيانات من خلايا متفرقة في خلية ذات خصائص "نص طويل"

[حامل المسك]

السلام عليكم ورحمة الله وبركاته،،

وعشر مباركات نسأل الله أن يبلغكم ما يرضيه عنا وعنكم فيها برحمته وتوفيقه،،

أيها الكرام..

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

لدي خانة معلومات 1 ومعلومات2 ومعلومات 3 يتم الاختيار منها أو الكتابة فيها وعند الضغط على كلمة اعتماد تنتقل البيانات المكتوب في خانة جميع البيانات مع مسح البيانات من خانة معلومات 1 و2 و3

ثم إذا كتبت مرة أخرى في خانة معلومات 1 ومعلومات 2 ومعلومات 3 وتم الضغط على أمر اعتماد تنتقل البيانات لخانة جميع البيانات مع ملاحظة عدم حذف البيانات السابقة وحبذا أن تكون بعد المؤشر

كما في الصورة التالية

وليس شرطا أن تكون المعلومات 1 و2 و3 في جدول واحد مع جميع البيانات.. المهم أن أحصل على خانة جميع البيانات سواء كانت في جدول مستقل أو في غيره..

ومرفق مثال مع جزيل الشكر

ترحيل بيانات.accdb

[kanory]

2 ساعات مضت, حامل المسك said:

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

لدي خانة معلومات 1 ومعلومات2 ومعلومات 3 يتم الاختيار منها أو الكتابة فيها وعند الضغط على كلمة اعتماد تنتقل البيانات المكتوب في خانة جميع البيانات مع مسح البيانات من خانة معلومات 1 و2 و3

ثم إذا كتبت مرة أخرى في خانة معلومات 1 ومعلومات 2 ومعلومات 3 وتم الضغط على أمر اعتماد تنتقل البيانات لخانة جميع البيانات مع ملاحظة عدم حذف البيانات السابقة وحبذا أن تكون بعد المؤشر

طيب .... استخدم هذه الشيفرة في الزر .... جرب 

    Dim currentText As String
    Dim newText As String
    newText = infoa.Value & ", " & anfo2.Value & ", " & info3.Value
    currentText = allinfo.Value
    If currentText <> "" Then
        allinfo.Value = currentText & ", " & newText
    Else
        allinfo.Value = newText
    End If
    infoa.Value = ""
    anfo2.Value = ""
    info3.Value = ""

 

[حامل المسك]

سلمت ..

أعطاني هذه الرسالة

[شايب]

55 دقائق مضت, حامل المسك said:

أعطاني هذه الرسالة

غير نوع المتغير من نوع نص الى  متنوع

وبالتالي نبدل السطر الاول الى

Dim currentText As Variant

اخونا الشايب

[حامل المسك]

الله الله إبداع إبداع..

لا حرمكم الله الأجر..

 وأسعدك ورضي عنكم،،

نحتاج تعديل أخير حتى لا تتكرر الفواصل في حال كانت الخلية فارغة.. حيث بالضغط في كل مرة يضع الفواصل فنجتاج لتعديل بحيث يتم نقل المعلومات في الخلية التي بها معلومات فقط..

 

Dim currentText As Variant

    Dim newText As String
    newText = infoa.Value & ", " & anfo2.Value & ", " & info3.Value
    currentText = allinfo.Value
    If currentText <> "" Then
        allinfo.Value = currentText & ", " & newText
    Else
        allinfo.Value = newText
    End If
    infoa.Value = ""
    anfo2.Value = ""
    info3.Value = ""

 

[kanory]

منذ ساعه, حامل المسك said:

 

نحتاج تعديل أخير حتى لا تتكرر الفواصل في حال كانت الخلية فارغة.. حيث بالضغط في كل مرة يضع الفواصل فنجتاج لتعديل بحيث يتم نقل المعلومات في الخلية التي بها

استبدل الشيفرة في الزر بهذا ....

    Dim currentText As Variant
    Dim newText As String
    newText = BuildNewText(infoa.Value, anfo2.Value, info3.Value)
    currentText = allinfo.Value
    If currentText <> "" Then
        allinfo.Value = currentText & ", " & newText
    Else
        allinfo.Value = newText
    End If
    infoa.Value = ""
    anfo2.Value = ""
    info3.Value = ""

ثم الصق هذا الفانك في النموذج ....

Private Function BuildNewText(ParamArray TextValues() As Variant) As String
    Dim i As Integer
    Dim textPart As Variant
    Dim result As String
    For i = LBound(TextValues) To UBound(TextValues)
        textPart = Trim(TextValues(i))
        If textPart <> "" Then
            If result <> "" Then
                result = result & ", "
            End If
            result = result & textPart
        End If
    Next i
    BuildNewText = result
End Function

 

[حامل المسك]

أستاذنا القدير @kanory

أستاذنا القدير @شايب

كلمات الشكر لا تفيكم حقكم...

فالحقيقة أن هذا المثال فتح لي آفاق كثيرة وكبيرة.. مع عدم اعتقادي بدءا بالإمكانية..

ولكن ذلك فضل الله علينا وعليكم في هذه العشر المباركات..

بارك الله لكم في أهلكم ومالكم وولدكم ورضي عنكم ورحم والديكم،،

تمت الإجابة ولله الحمد والمنة..