مفردات مرتب

[hesham_khadr200]

أرجو من أخواني التكرم وتقديم العون في هذا الطلب

طلبي هو طباعة نموذج مفردات المرتب لجميع المعلمين ا, العاملين

بطريقة طباعة جميع الشهادات للأخ الكريم خبور خير

ولكم جزيل الشكر

شئون العاملين.rar

[ياسر خليل أبو البراء]

أخ هشام خضر

جرب الملف التالي

أخوك أبو البراء

شئون العاملين.rar

[hesham_khadr200]

اخي الكريم ابو البراء

جزيل الشكر لك ولكل من يستجيب لطلبات الأخوه في المنتدي

عمل جميل ولكن هل من مزيد ان امكن

اريد عمل معاينة لجميع المعلمين قبل الطباعة

ممكن

[ياسر خليل أبو البراء]

قم بتعديل بسيط على الكود

Sub PrintAll()

Dim LastR As Integer

Sheets("ÈíÇäÇÊ ÇÓÇÓíÉ").Select

LastR = Sheets("ÈíÇäÇÊ ÇÓÇÓíÉ").Cells(Rows.Count, "B").End(xlUp).Row

Range("B6:B" & LastR).Select

x = Application.WorksheetFunction.CountA(Selection)


Sheets("ãÝÑÏÇÊ").Select

Range("A6").Select

Selection.ClearContents


For I = 1 To x

Range("A6") = I

ActiveWindow.SelectedSheets.PrintPreview

Next I

End Sub

[أحمدوفسيلادتش]

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

[مينا دعريش]

On 10/26/2010 at 12:17 PM, ياسر خليل أبو البراء said:

قم بتعديل بسيط على الكود

 

 

Sub PrintAll()

Dim LastR As Integer

Sheets("ÈíÇäÇÊ ÇÓÇÓíÉ").Select

LastR = Sheets("ÈíÇäÇÊ ÇÓÇÓíÉ").Cells(Rows.Count, "B").End(xlUp).Row

Range("B6:B" & LastR).Select

x = Application.WorksheetFunction.CountA(Selection)


Sheets("ãÝÑÏÇÊ").Select

Range("A6").Select

Selection.ClearContents


For I = 1 To x

Range("A6") = I

ActiveWindow.SelectedSheets.PrintPreview

Next I

End Sub

 

 

[احمد بدره]

يجب عند نسخ الكود أن تختار اللغة العربية أولا في شريط المهام  ثم قم بالنسخ واللصق

تفضل الكود  مع ملاحظة أن المعاينة والطباعة لموظف واحد فقط

 Sub PrintAll()

    Dim LastR As Integer

   Sheets("بيانات اساسية").Select

   LastR = Sheets("بيانات اساسية").Cells(Rows.Count, "B").End(xlUp).Row

    Range("B6:B" & LastR).Select

    x = Application.WorksheetFunction.CountA(Selection)

  Sheets("مفردات").Select

    Range("A6").Select

    Selection.ClearContents

    For I = 1 To x

    Range("A6") = I

    ActiveWindow.SelectedSheets.PrintPreview

    Next I

    End Sub