تغيير حجم الخط حسب عدد الكلمات في الخليه

[محمد مصطفى درويش]

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

أرجو المساعدة بايجاد كود برمجي او حل لهذه المشكلة التي تواجهني 

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

ملف العمل.xlsx

[ابا اسماعيل]

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

تفضل

قوم بتحديث البيانات في العمود اول مرة عند تضع الكود

 

 

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim cell As Range

    
    Set ws = ThisWorkbook.Sheets("Sheet1")

    '
    If Not Intersect(Target, ws.Columns("A")) Is Nothing Then
        Application.EnableEvents = False

       ص
        For Each cell In Target
            If cell.Value <> "" Then
                
                Dim wordCount As Long
                wordCount = Len(cell.Value) - Len(Replace(cell.Value, " ", "")) + 1

                
                If wordCount = 1 Then
                    cell.Font.Size = 14
                ElseIf wordCount = 2 Then
                    cell.Font.Size = 14 '
                ElseIf wordCount >= 3 Then
                    cell.Font.Size = 14
                End If

                cell.Font.Bold = True
                cell.Font.Name = "Arial"
            End If
        Next cell

        Application.EnableEvents = True '
    End If
End Sub

 

[محمد مصطفى درويش]

بارك الله فيك اشكرك على جهودك ، ربنا يديم عليك الصحة والعافية ويرزقك الجنة في الاخرة ❤️

 

يعطيك العافية استاذنا 

اعاني من نفس المشكلة مع هذا الكود حيث ان عدد حروف الكلمة الواحدة تختلف من كلمة الى اخرى هل بالامكان تعديل الكود بحيث يتم الزبط فيه بين عدد الحروف في الخلية وحجم الخط بحيث تكون العلاقة عكسية  بين عدد الحروف وحجم الخط بحيث كلما قل عدد الحروف يكبر الخط وكلما زاد عدد الحروف في الخلية يقل حجم الخط شاكرا جهودك استاذنا 

تم تعديل أغسطس 5, 2023 بواسطه محمد مصطفى درويش

[ابا اسماعيل]

تفظل جريب هذا الكود

 

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet
    Dim cell As Range

    Set ws = ThisWorkbook.Sheets("Sheet1")

    If Not Intersect(Target, ws.Columns("A")) Is Nothing Then
        Application.EnableEvents = False

        For Each cell In Target
            If cell.Value <> "" Then
                Dim charCount As Long
                charCount = Len(cell.Value) - Len(Replace(cell.Value, " ", ""))

                Dim fontSize As Long
                fontSize = 14 - charCount

                If fontSize < 8 Then
                    fontSize = 8
                End If

                cell.Font.Size = fontSize
            End If
        Next cell

        Application.EnableEvents = True
    End If
End Sub

 

[محمد مصطفى درويش]

بارك الله في عمرك ومالك وجميع احبابك ، لقد تفضلت علي بعطائك استاذنا 

[محمد مصطفى درويش]

استاذي هل تستطيع مساعدتي في كتابة كود برمجي اخر في العمود a وفي اي خلية في العمود اذا كان النص بالخلية بدون فراغ  فاريد تنسيق النص shring to fit ( احتواء مناسب) واذا كان النص بالخلية بفراغ بكون التنسيق wrap text (التفاف النص )  بمعنى اذا كان النص في اي خلية بالعمود a  يتكون من كلمة واحدة يكون التنسيق  shring to fit ( احتواء مناسب) واذا كان النص في اي خلية بالعمود a يتكون من كلمتين فأكثر   بكون التنسيق wrap text (التفاف النص )    شاكرا جهودك استاذنا . مرفق ملف العمل الجديد لتوضيح الفكرة

ملف العمل.xlsx

تم تعديل أغسطس 6, 2023 بواسطه محمد مصطفى درويش