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

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


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





قوائم فصول

السلام عليكم دمتم بخير وسلام ارجوا اكمال ملفى المرفق والمطلوب 1ـ عمل كود استدعاء البيانات للقائمة فى شيت 2 بعد تحديد ال ..


موضوع مغلق


subject icon تمت الإجابة قوائم فصول
16-10-2020 04:28 مساء
ابوملك زكريا
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 11-03-2020
رقم العضوية : 18490
المشاركات : 7
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 15-1-1990
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 30
 offline 

السلام عليكم
دمتم بخير وسلام ارجوا اكمال ملفى المرفق والمطلوب 
1ـ عمل كود استدعاء البيانات للقائمة فى شيت 2 بعد تحديد الفصل من القائمة المنسدلة 
2ـ عمل كود لطباعة القائمة 
 
 
  قوائم فصول.xlsm   تحميل xlsm مرات التحميل :(3)
الحجم :(34.602) KB



أفضل إجابة مقدمة من salim وهي:
كود الطباعة
للطباعة استبدل
SH2.PrintPreview (الذي يظهر معاينة قبل الطباعة)
بالسطر
SH2.PrintOut   (الذي برسل الورقة الى  الطباعة مباشرة)

Sub Print_Me()
  Dim LBMx%, LF%, LB%
LF = SH2.Cells(Rows.Count, "F").End(3).Row + 1
LB = SH2.Cells(Rows.Count, "B").End(3).Row

LBMx = Application.Max(SH2.Range("B2:B49")) + 6
SH2.Range("B6:B" & LF).EntireRow.Hidden = False
SH2.Range("B" & LBMx).Resize(LF - 3 - LBMx).EntireRow.Hidden = True
SH2.PageSetup.PrintArea = SH2.Range("B1:H" & LF).Address
SH2.PrintPreview
End Sub


 
عرض الإجابة




16-10-2020 07:09 مساء
مشاهدة مشاركة منفردة [1]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif قوائم فصول
للمرة الألف
فصل الجدول عن الخلايا التي لا شأن له بها بأعمدة وصفوف فارغة و عدم دمج الخلايا داخل الجدول وذلك كي يعمل الماكرو بشكل صحيح
هذا ينطبق على الصفحتين

Option Explicit

Sub My_filter()
Dim Rg_M As Range, Rg_S As Range
Dim Cret As Range
Dim LM%, LS%
LM = Main.Cells(Rows.Count, 4).End(3).Row

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

If LM < 5 Then GoTo Bay_Bay
Set Rg_M = Main.Range("D5:J" & LM)
Set Rg_S = SH2.Range("D6").CurrentRegion
Rg_S.ClearContents
SH2.Range("B6:B49").ClearContents
Set Cret = SH2.Range("E2")
SH2.Range("B6:b49").EntireRow.Hidden = False
Rg_M.AutoFilter 4, Cret
Main.Range("D6:D" & LM).SpecialCells(12).Copy
SH2.Range("D6").PasteSpecial (12)


Main.Range("H6:H" & LM).SpecialCells(12).Copy
SH2.Range("E6").PasteSpecial (12)


Main.Range("J6:J" & LM).SpecialCells(12).Copy
SH2.Range("F6").PasteSpecial (12)


Main.Range("I6:I" & LM).SpecialCells(12).Copy
SH2.Range("G6").PasteSpecial (12)


If Main.AutoFilterMode Then
 Main.Range("D5").AutoFilter
End If
LS = SH2.Range("D6").CurrentRegion.Rows.Count

SH2.Range("B6").Resize(LS).Value = _
Evaluate("Row(1:" & LS & ")")
SH2.Range("B6:b49").SpecialCells(4).EntireRow.Hidden = True
SH2.Range("B6").Select
Bay_Bay:
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub

الملف مرفق
 
 
  Fousoul_zakaria_.xlsm   تحميل xlsm مرات التحميل :(11)
الحجم :(51.823) KB


16-10-2020 08:26 مساء
مشاهدة مشاركة منفردة [2]
ابوملك زكريا
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 11-03-2020
رقم العضوية : 18490
المشاركات : 7
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 15-1-1990
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 30
 offline 
look/images/icons/i1.gif قوائم فصول
بارك الله فيك استاذنا الفاضل ومعلش على الاخطاء انا اخدت بالى من الاخطاء بعد ارسال الملف 
ممكن تفعيل زر الطباعة 

16-10-2020 09:32 مساء
مشاهدة مشاركة منفردة [3]
salim
خبير معتمد
rating
معلومات الكاتب ▼
تاريخ الإنضمام : 22-08-2017
رقم العضوية : 43
المشاركات : 853
الجنس : ذكر
تاريخ الميلاد : 1-5-1989
الدعوات : 1
يتابعهم : 13
يتابعونه : 33
قوة السمعة : 6607
عدد الإجابات: 67
 offline 
look/images/icons/i1.gif قوائم فصول
كود الطباعة
للطباعة استبدل
SH2.PrintPreview (الذي يظهر معاينة قبل الطباعة)
بالسطر
SH2.PrintOut   (الذي برسل الورقة الى  الطباعة مباشرة)

Sub Print_Me()
  Dim LBMx%, LF%, LB%
LF = SH2.Cells(Rows.Count, "F").End(3).Row + 1
LB = SH2.Cells(Rows.Count, "B").End(3).Row

LBMx = Application.Max(SH2.Range("B2:B49")) + 6
SH2.Range("B6:B" & LF).EntireRow.Hidden = False
SH2.Range("B" & LBMx).Resize(LF - 3 - LBMx).EntireRow.Hidden = True
SH2.PageSetup.PrintArea = SH2.Range("B1:H" & LF).Address
SH2.PrintPreview
End Sub


 

16-10-2020 10:44 مساء
مشاهدة مشاركة منفردة [4]
ابوملك زكريا
عضو
معلومات الكاتب ▼
تاريخ الإنضمام : 11-03-2020
رقم العضوية : 18490
المشاركات : 7
الدولة : مصر
الجنس : ذكر
تاريخ الميلاد : 15-1-1990
يتابعهم : 1
يتابعونه : 0
قوة السمعة : 30
 offline 
look/images/icons/i1.gif قوائم فصول
الف شكر ليك استاذ سليم
ربنا يجعله فى ميزان حسناتك بصراحه اكواد روعه 



الكلمات الدلالية
فصول ، قوائم ،


 










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

الساعة الآن 06:29 صباحا