أكاديمية الصقر للتدريب

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


أهلا وسهلا بك زائرنا الكريم في أكاديمية الصقر للتدريب، لكي تتمكن من المشاركة ومشاهدة جميع أقسام المنتدى وكافة الميزات ، يجب عليك إنشاء حساب جديد بالتسجيل بالضغط هنا أو تسجيل الدخول اضغط هنا إذا كنت عضواً .





تعديل جزئية تنسيق الخط واللون بكود

الاساتذة الافاضل ممكن اخواتى التعديل على هذه الجزئية بحيث يكون التنسيق مثل ما بالصف الاول [code]IFQuUm93cyhtIC0gMSkuQ2xl ..


موضوع مغلق

الصفحة 1 من 2 < 1 2 > الأخيرة »


18-06-2020 10:52 مساء
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 

الاساتذة الافاضل
ممكن اخواتى التعديل على هذه الجزئية بحيث يكون التنسيق مثل ما بالصف الاول
 T.Rows(m - 1).Clear
 With T.Range("A4:J" & m - 2)
 .Borders.LineStyle = 1: .InsertIndent 1
 .Font.Bold = True: .Font.Size = 14
 .Interior.ColorIndex = 55
 .Font.Color = 13395456
 On Error Resume Next
  For Each Sing_cel In .Columns(2).SpecialCells(4)
   Sing_cel.Offset(, -1).Resize(, 10) _
   .Interior.ColorIndex = 0

 Next Sing_cel
 End With
T.Activate: T.Range("A4").Select
    Application.ScreenUpdating = True


حيث ان هذا التنسيق جزء من كود واريد ان يصبح مثل ما بالصف الاول
مع الشكر الجزيل


سبب الاغلاق :الانتقال لموضوع آخر
 
 
  التنسيق.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(18.993) KB


19-06-2020 09:04 صباحا
مشاهدة مشاركة منفردة [1]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تعديل جزئية تنسيق الخط واللون بكود
السلام عليكم أختي الكريمة أم حمزة

حسب ما فهمت من كلامك أن الكود لديك يعمل وتريدين فقط إجراء تعديل ، ولكن بعد تحميل المرفق وتجربة الكود وجد خطأ وهو في أول سطر في الكود
وفي الحقيقة أستطيع التغلب على الخطأ وهو إنشاء ورقة عمل وتسميتها بالاسم البرمجي ليكون T ، ولكني لن أفعل ، لأنه من المفترض ألا أضيع الوقت في مجاراة الكود لكي يعمل بشكل صحيح ثم أبحث عن حل للمشكلة التي تريدين حلها.
الرجاء إرفاق ملف به الكود يعمل بشكل صحيح ، والتركيز بعد ذلك يكون في النقطة التي تريدين القيام بها ...
كما يرجى في الكود أن يتم الإعلان عن المتغيرات .. هذه عاذة جيدة ولابد من الالتزام بها

19-06-2020 09:16 صباحا
مشاهدة مشاركة منفردة [2]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل جزئية تنسيق الخط واللون بكود
اعتذر استاذ ياسر
كنت اتخيل انى اكتب الجزء المراد تعديله فقط
هو الكود يعمل تمام بس اريد تغير ارقام الالوان لتعطينى التنسيق الموجود باول سطر
هاهو الكود
Sub My_FindNext()
    Dim T As Worksheet, Sh As Worksheet
    Dim Opt_rg As Range, Sing_cel As Range
    Dim Find_Range, SH_rg As Range
    Dim My_rg As Range
    Dim Ro1%, m%, RO%, col%
    Dim mot
    Dim x As Boolean
    Dim Match As Boolean
  Dim arr(1 To 3)
  arr(1) = "data": arr(2) = "datac": arr(3) = "takrir":
Set T = Sheets("takrir")
RO = T.Cells(Rows.Count, 2).End(3).Row
If RO < 4 Then RO = 4
T.Range("A4:j" & RO + 1).Clear
Set Find_Range = T.Range("a2:J2").Find("*", Lookat:=1)
If Find_Range Is Nothing Then
 MsgBox "not Found"
 Exit Sub
End If
m = 4
mot = Find_Range.Value: col = Find_Range.Column - 1
 For Each Sh In Sheets

Match = IsError(Application.Match(Sh.Name, arr, 0))
If Not Match Then GoTo Next_Sheet

  Set SH_rg = Sh.Range("A1:I10000").Columns(col)

  Set Find_Range = SH_rg.Find(mot, Lookat:=1)
  If Find_Range Is Nothing Then GoTo Next_Sheet
  
Do While Not Find_Range Is Nothing
        If Not x Then
         Ro1 = Find_Range.Row
         x = True
        End If
       '==============================================
    If Opt_rg Is Nothing Then
      Set Opt_rg = Sh.Cells(Find_Range.Row, 1).Resize(, 9)
    Else
      Set Opt_rg = Union(Opt_rg, Sh.Cells(Find_Range.Row, 1).Resize(, 9))
    End If
     Set Find_Range = SH_rg.FindNext(Find_Range)
     If Find_Range.Row = Ro1 Then Exit Do
Loop
  If Not Opt_rg Is Nothing Then
  
  Opt_rg.Copy
  T.Cells(m, 2).PasteSpecial (12)
  T.Cells(m, 1) = Sh.Name
  Set Opt_rg = Nothing: m = T.Cells(Rows.Count, 2).End(3).Row + 2
  Application.CutCopyMode = False
  x = False
  End If
   '========================================
Next_Sheet:
 Next Sh
    If m = 4 Then
      MsgBox "No Found Data"
      Exit Sub
    End If
T.Rows(m - 1).Clear
 With T.Range("A4:J" & m - 2)
 .Borders.LineStyle = 1: .InsertIndent 1
 .Font.Bold = True: .Font.Size = 14
 .Interior.ColorIndex = 19
 On Error Resume Next
  For Each Sing_cel In .Columns(2).SpecialCells(4)
   Sing_cel.Offset(, -1).Resize(, 10) _
   .Interior.ColorIndex = 35
 Next Sing_cel
 End With
T.Activate: T.Range("A4").Select
End Sub

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

19-06-2020 10:16 صباحا
مشاهدة مشاركة منفردة [3]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تعديل جزئية تنسيق الخط واللون بكود
أعتقد الكود للأخ سليم .. مشاركته ستكون أفضل وأسرع من مشاركتي
فلننتظر مشاركة المتميز سليم

19-06-2020 12:23 مساء
مشاهدة مشاركة منفردة [4]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل جزئية تنسيق الخط واللون بكود
  أعتذر عن المساعدة لسببين 
1-لأن الأخت ام حمزة لم تحترم حقوق الملكية الفكرية من  خلال عدم  الأشارة
   الى من وضع الكود في مشاركتها 
2- أكثر من مرة قلت لها لا ترفعي ملفاَ فارغاً
     (10 - 15 صف في كل صفحة) لمعرفة المطلوب و تتبع خطوات الكود
    اذ   لست أنا ولا اي احد ملزماً بأن يقوم بتعبئة الأوراق ببيانات  ولو كانت عشوائية

19-06-2020 01:41 مساء
مشاهدة مشاركة منفردة [5]
omhamzh
عضو فعال
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 27-05-2020
رقم العضوية : 19308
المشاركات : 137
الجنس : أنثى
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 225
 offline 
look/images/icons/i1.gif تعديل جزئية تنسيق الخط واللون بكود
 
اقسم بالله عن جهل ولم اقصد 
انا معرفش والله 
وحضرتك صاحب الكود وانا لم اقل ان حد هو صاحب الكود
انا جديدة بكل المنتديات ومعدنيش فكرة كتير عن انى اذكر صاحب الكود هى دى اول مرة وانا اعتذر  بس والله عن جهل
وانا ماقدرش ان حضرتك تزعل منى انت صاحب فضل كبير اخى فى الله عليا
ودى غلطة غير مقصودة معلش سامحنى
اختك والله لسه بتتعلم فى المنتديات معذرة 
 
 
 
  takrer.xlsm   تحميل xlsm مرات التحميل :(2)
الحجم :(65.596) KB


19-06-2020 01:52 مساء
مشاهدة مشاركة منفردة [6]
YasserKhalil
مراقب عام
معلومات الكاتب ▼
تاريخ الإنضمام : 21-08-2017
رقم العضوية : 3
المشاركات : 10455
الجنس : ذكر
تاريخ الميلاد : 1-10-1978
الدعوات : 24
يتابعهم : 1
يتابعونه : 536
قوة السمعة : 36632
عدد الإجابات: 256
 offline 
look/images/icons/i1.gif تعديل جزئية تنسيق الخط واللون بكود
أختي الكريمة أم حمزة
الكلام ليس موجهاً لكي وحدك في غالب الأحيان ، بل إن هذه المشكلة كثيراً ما تحدث لذا وجب التنبيه.. 
نرجو من الأخ سليم أن يقبل الاعتذار فهذا أمر غير مقصود بالتأكيد .. وإن عاودت الكرة لك أن  تفعل ما تشاء ..


الصفحة 1 من 2 < 1 2 > الأخيرة »


الكلمات الدلالية
اريد ، الخط ، ابيض ، الكود ،


 










اخلاء مسئولية: يخلى منتدى أكاديمية الصقر للتدريب مسئوليته عن اى مواضيع او مشاركات تندرج داخل الموقع ويحثكم على التواصل معنا ان كانت هناك اى إنتهاكات تتضمن اى انتهاك لحقوق الملكية الفكرية او الادبية لاى جهة - بالتواصل معنا من خلال نموذج مراسلة الإدارة .وسيتم اتخاذ الاجراءات اللازمة.
سياسة النشر: التعليقات المنشورة لا تعبر عن رأي منتدى أكاديمية الصقر للتدريب ولا نتحمل أي مسؤولية قانونية حيال ذلك ويتحمل كاتبها مسؤولية النشر.

الساعة الآن 05:30 مساء