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

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

قام بنشر

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

 

ياخوان عندي ملف word ومكون من جدول انا حاب في احد الخلايا عند اداخل مثلا رقم 1 يتم تعبئة الخلية باللون الاحمر واذا ادخل المستخدم 2 يتم تعبئة الخلية باللون الاصفر و3 باللون الاخضر

 

                                                        

 

اتمنى من الله ثم منكم المساعدة مع خالص الشكر والتقدير

 

قام بنشر

السلام عليكم

 

على حد علمي ، لا يوجد حل مباشر مثلما  هو الحال في الاكسيل

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

اما عن الحل المباشر فكما ذكرت لك على حد علمي لا يوجد ، و الله اعلم

قام بنشر

السلام عليكم

 

هذه أولى المحاولات

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

- انها تتعامل مع اول جدول فى الملف

- أنها تقرأ تفترض ان الارقام كلها اقل من 100 اي رقمان فقط

 

شغل الماكرو على ملف به جدول واحد به بعض الارقام منها 34

سيتم تغيير لون كل ما هو 34 الى اللون الاخضر

Sub mytable()
Dim strCellText As String
 Dim myrow, mycol   As Integer
 
myrow = ActiveDocument.Tables(1).Rows.Count
mycol = ActiveDocument.Tables(1).Columns.Count
 
For i = 1 To myrow
    For j = 1 To mycol
        With ActiveDocument.Tables(1).Cell(i, j).Range
        Debug.Print .text
        
         If Left(.text, 2) = 34 Then
           .Font.ColorIndex = wdBrightGreen
         End If
        End With
    Next
Next

End Sub
قام بنشر

التعديل الثاني :

 

الان يتم التطبيق على الجدول الذي تقف فيه دون التقيد بكونه الجدول الاول ، اي توقف فى اي خلية و شغل الماكرو نفسه mytable

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

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

 

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

و فى هذا المثال لا يوجد قيود على الارقام سوى انها ارقام صحيحة

 

 

و الان فى المثال المرفق :

ضع المؤشر فى اي  جدول ، ثم اضغط

ALT+F8

و شغل الماكرو 

mytable

سيتم تلوين كافة الخلايا فى هذا الجدول فقط باللون الاخضر اذا كانت قيمتها اكير من 40

 

و يمكن طبعا تعديل الشرط و اللون بسهولة

 

مرفق المثال

TableFormat02.rar

 

و هذا هو الكود

Public mytableno As Integer


Sub mytable()


Dim strCellText As String
Dim myrow, mycol, mytable  As Integer
Call FindTableNumber


myrow = ActiveDocument.Tables(mytableno).Rows.Count
mycol = ActiveDocument.Tables(mytableno).Columns.Count


For i = 1 To myrow
    For J = 1 To mycol
        With ActiveDocument.Tables(mytableno).Cell(i, J).Range
        Dim cellval As Integer
        If Len(.text) > 2 Then
        cellval = CInt(Left(.text, (Len(.text) - 2)))
        'Debug.Print cellval
          If cellval > 40 Then
           .Font.ColorIndex = wdBrightGreen
         End If
         End If
        End With
    Next
Next


End Sub






Sub FindTableNumber()
'based on code from this source http://wordribbon.tips.net/T010897_Index_Number_for_the_Active_Table.html


    Dim J As Integer
    Dim iTableNum As Integer
    Dim oTbl As Table


    Selection.Bookmarks.Add ("TempBM")
    For J = 1 To ActiveDocument.Tables.Count
        Set oTbl = ActiveDocument.Tables(J)
        oTbl.Select
        If Selection.Bookmarks.Exists("TempBM") Then
            iTableNum = J
            Exit For
        End If
    Next J
    ActiveDocument.Bookmarks("TempBM").Select
    ActiveDocument.Bookmarks("TempBM").Delete
    'MsgBox "The current table is table " & iTableNum
    mytableno = iTableNum
End Sub
  • Like 2

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

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

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

Important Information