اذهب الي المحتوي
أوفيسنا

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


إذهب إلى أفضل إجابة Solved by kanory,

الردود الموصى بها

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

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

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

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

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

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

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

image.png.9fc3de648942eeb9115d42bb6bc45c25.png

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

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

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

رابط هذا التعليق
شارك

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 = ""

 

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

 

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 = ""

 

رابط هذا التعليق
شارك

  • أفضل إجابة
منذ ساعه, حامل المسك 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

 

  • Like 1
رابط هذا التعليق
شارك

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

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

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

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

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

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

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

  • Thanks 1
رابط هذا التعليق
شارك

من فضلك سجل دخول لتتمكن من التعليق

ستتمكن من اضافه تعليقات بعد التسجيل



سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information