رجب جاويش

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

أخى الفاضل / محمد بالنسبة للكود السطر التالى تعريف لبعض المتغيرات Dim x As Integer, i As Integer, LR As Integer السطر التالى x = 14 يضع قيمة للمتغير X تساوى 14 وهو أول سطر يتم لصق البيانات فى الورقة التى يتم الترحيل اليها ( ورقة 2 ) السطر التالى Sheets("ورقة2").Range("A14:CA1000").ClearContents يمسح البيانات القديمة الموجودة فى ورقة 2 السطر التالى LR = Cells(Rows.Count, 1).End(xlUp).Row يتم تحديد أخر صف يحتوى على بيانات فى الورقة المحتوية على البيانات المراد ترحيلها ووضعها داخل المتغير LR السطر التالى Application.ScreenUpdating = False يوقف اهتزاز الشاشة الجزء التالى For i = 13 To LR Next حلقة تكرار من الصف 13 ( أول صف بيانات ) الى آخر صف به بيانات السطر التالى Cells(i, 1).Resize(1, 79).Copy نسخ البيانات المكونة من صف واحد و79 عمود ( حسب البيانات ) السطر التالى Sheets("ورقة2").Range("A" & x).PasteSpecial xlPasteValues لصق البيانات فى ورقة 2 السطر التالى x = x + 2 زيادة قيمة المتغير X بمقدار 2 حتى يتم ترك صف فراغ بعد كل اسم السطر التالى Application.CutCopyMode = False ايقاف خاصية اللنسخ واللصق السطر التالى Application.ScreenUpdating = True ارجاع خاصية اهتزاز الشاشة كما كانت

أخى الحبيب / عباس السماوي شكرا جزيلا أخى الحبيب على المرور العطر والكلمات الطيبة

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

أخى الفاضل / نور جزاك الله كل خير

أخى ابراهيم جزاك الله كل خير

أخى الفاضل يرجى ارفاق ملف للعمل عليه

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

أخى ابراهيم العملية تعتمد على معرفة ارتفاع التكستات ( من الخاصية Height ) وقيمة المسافة بينها

الأستاذ الفاضل / مجدى يونس شكرا جزيلا على هذا المرور العطر

تفضل اخى ابراهيم Private Sub Load_pic_Click() Image_path = Application.GetOpenFilename( _ FileFilter:="Picture Files (*.gif;*.jpg;*.jpeg;*.bmp),*.gif;*.jpg;*.jpeg;*.bmp", _ Title:="اختار صورة") Sheets("sheet2").Range("a1") = Image_path ActiveWorkbook.Save If Image_path <> False Then Me.Lab_pic.Picture = LoadPicture(Image_path) End If End Sub Private Sub UserForm_Initialize() If Sheets("sheet2").Range("a1") <> "" Then Me.Lab_pic.Picture = LoadPicture(Sheets("sheet2").Range("a1")) End If End Sub ادراج صوره فى لابل2.rar

الأستاذ الفاضل / مجدى يونس شكرا جزيلا لك وجزاك الله كل خير

أخى ابراهيم قم بزيادة الخاصية ScrollHeight لكل فريم الى 250 ستلاحظ حل المشكلة Book1.rar

تفضل أخى ابراهيم Private Sub Load_pic_Click() Image_path = Application.GetOpenFilename( _ FileFilter:="Picture Files (*.gif;*.jpg;*.jpeg;*.bmp),*.gif;*.jpg;*.jpeg;*.bmp", _ Title:="اختار صورة") If Image_path <> False Then Me.Lab_pic.Picture = LoadPicture(Image_path) End If End Sub ادراج صوره فى لابل.rar

تفضل أخى تعديل كود الدوائر الحمراء الدور الثانى علمى.rar

أخى الحبيب / جمال ( أبو محمود ) دائما مبدع ودائما لديك الجديد بارك الله فيك

أخى الفاضل تفضل المعادلة وهى على فكرة من معادلات الصفيف ولكى تظهر الأقواس { } فانه عند ادخال المعادلة أو التعديل عليها لابد من الوقوف فى جزء من المعادلة والضغط على مفاتيح CTRL + SHIFT + ENTER معا محاسبة-منتدى+-+.rar

تفضل أخى Sub ragab() Dim x As Integer, i As Integer, LR As Integer x = 14 Sheets("ورقة2").Range("A14:CA1000").ClearContents LR = Cells(Rows.Count, 1).End(xlUp).Row Application.ScreenUpdating = False For i = 13 To LR Cells(i, 1).Resize(1, 79).Copy Sheets("ورقة2").Range("A" & x).PasteSpecial xlPasteValues x = x + 2 Application.CutCopyMode = False Next Application.ScreenUpdating = True End Sub ترحيل.rar

أخى الفاضل / Mohammed fahmy شكرا جزيلا وجزاك الله كل خير

أخى الفاضل / sh3esha3 شكرا جزيلا أخى الفاضل وجزاك الله كل خير

تفضل أخى تاريخ.rar

أخى الفاضل /kashef لا شكر على واجب أخى الفاضل فهذا واجبنا نخو إخوتنا فى هذا المنتدى العريق

أخى الحبيب / حمادة عمر تسلم ايديك دائما لك لمسات نهائية سحرية جزاك الله كل خير

أخى الفاضل شكرا جزيلا تفضل طلبك الخاص بالتكستات الفارغة شاشة ادخال 5.rar

تفضل أخى Sub RG_Hide() Dim LR As Integer, i As Integer LR = Cells(Rows.Count, 2).End(xlUp).Row '======================================= Application.ScreenUpdating = False For i = LR To 5 Step -1 If Cells(i, 2).Value = "--------" Or IsEmpty(Cells(i, 2)) Then Rows(Cells(i, 2).Row).Hidden = True End If Next Application.ScreenUpdating = True End Sub Sub RG_Show() Cells.Rows.Hidden = False End Sub kashef1.rar