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

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


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





تعديل مكرو الترحيل

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


موضوع مغلق

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


28-03-2021 10:17 مساء
نور وحيد
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-08-2017
رقم العضوية : 315
المشاركات : 38
الجنس : ذكر
تاريخ الميلاد : 1-1-1980
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 39
 offline 

بسم الله الرحمن الرحيم
الاخوة الافاضل تحيه طيبة بعد
مرفق شيت اكسل به فاتورة بها كود ترحيل الي صفحات مختلفة حسب الموجود في l1(مشتروات - مرتجع - مبيعات) وعند الضغط علي كود الترحيل يتم الترحيل الي الصفحة المختارة وعند اضافة فاتورة جديدة يتم ترحيلها مكان الفاتورة السابقة بدلا من الترحيل اسفل منها كما ارغب في عمل اطار (حد خارجي لكل فاتورة مرحله اطار سميك) ارجوا ان يكون الترحيل قيم فقط دون التاثير في المعادلات الموجوده في الفاتورة والملونه بالون الاصفر no_1
 
 
  مشروع دفتر حسابات.rar   تحميل rar مرات التحميل :(10)
الحجم :(29.123) KB



أفضل إجابة مقدمة من salim وهي:
تم التعديل كما تريد
1-لتغريع الخلايا التي لا تحتوي معادلات قم بازالة الغاصلة العليا من امام
          هذا السطر    'Fix_Rg.ClearContents
2- الخلايا التي  تحتوي معادلات محمية ضد المسح والتعديل

Option Explicit
Sub From_Fatura_ALL()
Dim F As Worksheet
Dim Sw As Worksheet
Dim FRg As Range, Srg As Range
Dim Fix_Rg As Range
Dim Rf%, Cf%, Max_Row%
Dim x%, Y%

Set F = Sheets("فاتوره")
F.Protect UserInterfaceOnly:=True

Rf = F.Cells(Rows.Count, 5).End(3).Row
If Rf = 4 Then Exit Sub
Cf = 15
Set FRg = F.Range("C7").Resize(Rf - 6, Cf)

Set Fix_Rg = FRg.SpecialCells(xlCellTypeConstants)

x = Fix_Rg.Rows.Count: Y = FRg.Columns.Count

If F.Range("l1") = vbNullString Then Exit Sub
Set Sw = Sheets(F.Range("l1").Value)
Max_Row = Sw.Cells(Rows.Count, "E").End(3).Row + 1
If Max_Row < 8 Then Max_Row = 8


Sw.Range("C" & Max_Row).Resize(x, Y).Value = _
FRg.Value
    With Sw.Range("B" & Max_Row).Resize(x, Y + 1)
     .Borders.LineStyle = 1
     .Font.Size = 14
     .Font.Bold = True
     .InsertIndent 1
     .Cells(1, 1).Resize(x).Value = _
      Evaluate("row(1:" & x & ")")
     .Interior.ColorIndex = 35
    End With
         
          'Use This line to delete cells
          'That NoT contains Formula
       ''''''''''''''''''''''''''''''''''''''
         'Fix_Rg.ClearContents
       ''''''''''''''''''''''''''''''''''''''''
    Set Sw = Nothing: Set F = Nothing
    Set FRg = Nothing
    Set Srg = Nothing
    Set Fix_Rg = Nothing
End Sub


الملف من جديد
 
عرض الإجابة




29-03-2021 07:11 صباحا
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل مكرو الترحيل
1- مجرد النظر الى الملف من ناحية زركشة الألوان الفاقعة تجعل من
          يريد المساعدة ينفر من ذلك
2- لا احد يعمل مع جداول فارغة 
لذلك نضيحة كي تلقي المساعدة:
1- تنسيقات عادية للخلايا
2- املأ الجداول (10 الى 15 صف في كل منها) ببيانات عشوائية
 

29-03-2021 02:30 مساء
مشاهدة مشاركة منفردة [2]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل مكرو الترحيل
للمرة المائة بعد العشرة الآف ( عدم ادراج خلايا مدمجة داخل الجدول)
1-تم ادراج صف في الشيت "فاتورة" فارغ لفصل الجدول عن الخلايا المدمجة (الصف رقم 6  تم اخفاؤه)
2- تم تعبئة الجدول ببيانات عشوائية
3- ازالة الزركشات التي تسبب بتضخيم الملف دون جدوى
الكود 

Option Explicit
Sub From_One_To_ALL()
Dim F As Worksheet
Dim Sw As Worksheet
Dim FRg As Range, Srg As Range
Dim Rf%, Cf%
Dim x%, Y%

Set F = Sheets("فاتوره")
Rf = F.Cells(Rows.Count, 4).End(3).Row
Cf = 15
Set FRg = F.Range("C7").Resize(Rf - 12, Cf)
x = FRg.Rows.Count: Y = FRg.Columns.Count

If F.Range("l1") = vbNullString Then Exit Sub
Set Sw = Sheets(F.Range("l1").Value)

Sw.Range("C8").Resize(500, Y).Clear
Sw.Range("C8").Resize(x, Y).Value = _
FRg.Value
    With Sw.Range("B8").Resize(x, Y + 1)
     .Borders.LineStyle = 1
     .Font.Size = 14
     .Font.Bold = True
     .InsertIndent 1
     .Cells(1, 1).Resize(x).Value = _
      Evaluate("row(1:" & x & ")")
     .Interior.ColorIndex = 35
    End With
 
    Set Sw = Nothingg
    Set FRg = Nothing
    Set Srg = Nothing
End Sub

الملف مرفق
 
 
 
  Check_UP.xlsm   تحميل xlsm مرات التحميل :(8)
الحجم :(59.505) KB


30-03-2021 01:00 صباحا
مشاهدة مشاركة منفردة [3]
نور وحيد
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-08-2017
رقم العضوية : 315
المشاركات : 38
الجنس : ذكر
تاريخ الميلاد : 1-1-1980
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 39
 offline 
look/images/icons/i1.gif تعديل مكرو الترحيل
تحية طيبة الاستاذ الفاضل / salim
من ناحية ملحوظه الاولي بخصوص بهرجه الالوان فانا كنت بعملها لتعليم الخلايا التي تم عمل المعادلات بها وكنت هلغيها فيما بعد ولكن حضرتك معك حق كان المفروض اشلها قبل الرفع
اما من حيث قلة البيانات فانا اسف علي لك 
وبخصوص التعديل التي تمت علي الملف في جميلة الا اني عند الضغط ع زر الترحيل ظهرة رساله 
compile error
varlable not defined
ويظلل اسم الكود بالون الاصفر 
ويتم تحديد nothing
في سطر set sw=nothing
اخير اشكر حضرتك علي الاطاله وارجوا سعه الصدر حيث اني في بداية التعلم                    وشكر
 

30-03-2021 05:50 صباحا
مشاهدة مشاركة منفردة [4]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل مكرو الترحيل
بسيطة غلطة املائية
استبدل المريع الاجمر بالمريع الأخضر كما في الصورة
( جرف الـــ g مرة واحدة) EUpeD_Pict_1

 
 
 


30-03-2021 10:32 مساء
مشاهدة مشاركة منفردة [5]
نور وحيد
عضو مشارك
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 30-08-2017
رقم العضوية : 315
المشاركات : 38
الجنس : ذكر
تاريخ الميلاد : 1-1-1980
يتابعهم : 3
يتابعونه : 1
قوة السمعة : 39
 offline 
look/images/icons/i1.gif تعديل مكرو الترحيل
السلام عليكم ورحمه الله وبركاته جزاك الله خيرا علي مساعدة حضرتك وبالنسبة للكود فقد تم الاستبدال ولكن مع الاسف لم يعمل الكود اساسا ولم ينتج عنه اي رد فعل
 
 
  Check_UP.xlsm   تحميل xlsm مرات التحميل :(1)
الحجم :(52.676) KB


30-03-2021 10:54 مساء
مشاهدة مشاركة منفردة [6]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif تعديل مكرو الترحيل
كيف لم يحصل اي شيء و لم تذهب الى صفحة الترحيل وتشاهد ماذا جرى بعد الخطوة رقم 2 (الضغط على الزر) من هذه الصورة
v1LzI_Pic_3


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


الكلمات الدلالية
الترحيل ، تعديل ، مكرو ،


 










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

الساعة الآن 11:18 صباحا