Abdelhady Tahoon قام بنشر أغسطس 4, 2013 مشاركة قام بنشر أغسطس 4, 2013 طلب كود لوضع خط مائل على الدرجة اقل من الربع بحيث يكون الخط مائل وليس اسفل الرقم رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أغسطس 4, 2013 مشاركة قام بنشر أغسطس 4, 2013 السلام عليكم Sub A_qtr() Dim الربع%, الدرجة% Dim Rn As Range ''*************** ' حط قيمة الدرجة الدرجة = 100 For Each Rn In [A2:A1000] ' المدى المراد تطبيق الكود عليه If Val(Rn) < (الدرجة / 4) Then Rn.Font.Italic = True Next End Sub 1 رابط هذا التعليق شارك More sharing options...
Abdelhady Tahoon قام بنشر أغسطس 4, 2013 الكاتب مشاركة قام بنشر أغسطس 4, 2013 اخى الكريم عياد شكراً على اهتمامك (لقد نفذت الخطوات التى قلت عليها ولم يحدث اى شى سوى تغير نوع الخط ) رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أغسطس 6, 2013 مشاركة قام بنشر أغسطس 6, 2013 (معدل) السلام عليكم جرب الكود التالي علي فهمت ماتريد Private Const Sm As String = "$A$2:$A$1000" Sub A_qtr() Dim الربع%, الدرجة% Dim Rn As Range, Sn As Shape ''*************** ' حط قيمة الدرجة الدرجة = 100 On Error Resume Next D_Shp For Each Rn In Range(Sm) ' المدى المراد تطبيق الكود عليه With Rn If Val(Rn) < (الدرجة / 4) And Not IsEmpty(Rn) Then Set Sn = ActiveSheet.Shapes.AddShape(183, .Left + 4, .Top + 3, .Width / 1.3, .Height - 7) With Sn .ForeColor.RGB = RGB(255, 0, 0) .BackColor.RGB = RGB(0, 170, 170) End With End If End With Next End Sub Private Sub D_Shp() Dim Sn As Shape For Each Sn In ActiveSheet.Shapes Sn.Delete Next End Sub تم تعديل أغسطس 6, 2013 بواسطه عباد رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أغسطس 6, 2013 مشاركة قام بنشر أغسطس 6, 2013 السلام عليكم بعد اذن اخي الحبيب ابو انصار وائراءا للموضوع شاهد المرفق 2003 اضافة خظ مائل الى ربع الدرجة.rar 1 رابط هذا التعليق شارك More sharing options...
الـعيدروس قام بنشر أغسطس 7, 2013 مشاركة قام بنشر أغسطس 7, 2013 استاذ عبدالله حفظك الله ورعاك عمل في قيمة الروعة بارك الله لك في علمك وزادك اضعافا اسمح لي بااستفسار بسيط الجزئيه التاليه من الكود shp.AutoShapeType AutoShapeType و type انا حاولت استخدام type للإشارة الى نوع الشكل لحذفه فقط في المدى المعني ولم ينفذ الكود كالتالي Private Sub D_Shp() Dim Sn As Shape With ActiveSheet For Each Sn In .Shapes If Not Intersect(Sn.TopLeftCell, .Range(Sm)) Is Nothing Then If Sn.type = 183 Then Sn.Delete End If Next Sn End With End Sub هل type لاتعمل على 2007 وجزاك الله الف خير على ماتقدمه لنا من علم غزير رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أغسطس 7, 2013 مشاركة قام بنشر أغسطس 7, 2013 السلام عليكم جرب هذا الكود Sub D_Shp() Dim Sn As Shape For Each Sn In ActiveSheet.Shapes If Sn.AutoShapeType = 183 Then Sn.Delete Next End Sub انا جربته على 2010 يعمل تمام رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.