تعديل فورم للاستاذ خبور

[خالد الشاعر]

السادة الخبراء

هذا عمل عظيم من اعمال الاستاذ خبور خير

فى صفحة التقرير يلصق البيانانات فى عمود B

حاولت اعدل عمود الصق فى عمود A لم اوصل لحل

فهل ممكن ذلك

بعد اذن الاستاذ العظيم خبور خير

و جزاكم الله خيراً

اعداد تقارير مدرسية.rar

[عبدالله باقشير]

السلام عليكم

تم التعديل في ثلاث اسطر

اولا في كود اللصق

Private Sub Kh_Start(iColumn As Integer)

Dim RCount As Long, C As Integer

'C = Cells(iRow, Columns.Count).End(xlToLeft).Column + 1

C = Application.WorksheetFunction.CountA(Rows(iRow)) + 1

With MyRng

    RCount = .Cells(.Rows.Count, 1).End(xlUp).Row

    .Cells(1, iColumn).Resize(RCount, 1).Copy

    '  لصق عرض الاعمدة

    Cells(iRow, C).PasteSpecial xlPasteColumnWidths

    '  لصق الفورمات

    Cells(iRow, C).PasteSpecial xlPasteFormats

    '  لصق القيم

    Cells(iRow, C).PasteSpecial xlPasteValues

    Application.CutCopyMode = False

End With

End Sub

============================================================== تم تغيير السطر

C = Cells(iRow, Columns.Count).End(xlToLeft).Column + 1

الى

C = Application.WorksheetFunction.CountA(Rows(iRow)) + 1

السطر القديم كان يحسب آخر عمود ويضيف له القيمة واحد ولما يكون العمود الاول هو آخر عمود يحسب 1+1 ولكن السطر الجديد ولما يكون العمود الاول هو آخر عمود تكون قيمة المعادلة 0+1 وهو العمود الاول ==============================================================

Private Sub kh_MyRngSet()

With Sheets(Sh_Report)

    .Select

    .Range(Cells(iRow, 1), Cells(.Rows.Count, .Columns.Count)).Clear

    .PageSetup.PrintArea = ""

End With

With Sheets(Sh_MyDate)

    Set MyRng = .Range(MyRng_MyDate)

End With

Num = MyRng.Columns.Count

End Sub

=========================================================== تم تغيير السطر

.Range(Cells(iRow, 2), Cells(.Rows.Count, .Columns.Count)).Clear

الى

.Range(Cells(iRow, 1), Cells(.Rows.Count, .Columns.Count)).Clear

ليشمل مسح العمود الاول ايضا =============================================================================

Private Sub Kh_PageSetup()

Dim LastRow As Long

Dim LastColumn As Integer

With Sheets(Sh_Report)

    LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row

    LastColumn = .Cells(iRow, Columns.Count).End(xlToLeft).Column

    With .PageSetup

        .PrintArea = Range("A1", Cells(LastRow, LastColumn)).Address

        .Zoom = False

        .FitToPagesWide = 1

        .FitToPagesTall = False

    End With

End With

End Sub

تم تعديل السطر

.PrintArea = Range("B1", Cells(LastRow, LastColumn)).Address

الى

.PrintArea = Range("A1", Cells(LastRow, LastColumn)).Address

ليدخل العمود الاول في نطاق الطباعة

ارجوا ان يكون الشرح مفهوما

ملحوظة : تم اشعاري بالبريد بالرد على هذا الموضوع للاهمية

الاخ الحبيب كيماس حفظه الله

وتقبلوا تحياتي وشكري

اعداد تقارير مدرسية.rar

ثانيا في كود المسح

ثالثا في كود تعيين الطباعة

[خالد الشاعر]

اشكرك استاذ خبور

على الاهتمام و الرد

تسلم يدك

و جعلك الله عوناً للاخرين

جزاك الله خيرا

[ابو الآء]

استاذنا الكبير

خيور خير

بارك الله فيك

وجعلك عوناً للجميع

ياريت مش تنسانا

خصوصا موضوع الجداول المدرسي

تقبل الله منا ومنك صالح الاعمال