كود طباعة بيان نجاح

[تهانى فكرى]

السادة الاعزاء خبراء الاكسيل ارجو مساعدتى فى عمل كود لطباعة جميع اوراق بيان النجاح حيث ان  الخلية 

G1 هى الخلية التى تتغير بها البيانات

والخلية D1  تحتوى على عدد جميع بيانات النجاح

بيان نجاح و للكشف درجات.xlsx

[أ / محمد صالح]

تمت معالجة هذا الأمر كثيرا قبل ذلك

ربما تفيدك هذه الروابط

Showing results for 'طباعة الكل pdf' in content posted in منتدى الاكسيل Excel . - أوفيسنا (officena.net)

بالتوفيق

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

يمكنك استخدام الكود التالي لطباعة الكل او تحديد بيانات النجاح المرغوب طباعتها او حفظها  بصيغة PDF بإسم الطالب  في مجلد في نفس مسار الملف الرئيسي 

بادخال رقم البداية ورقم النهاية في مربع الاختيار 

Private Sub CommandButton1_Click()

    Dim PagFirst As Long, PagEnd As Long, i As Long
    Dim FolderName As String, MsgChoose As VbMsgBoxResult
    Dim filePath As String, wbPath As String, fileStart As String
    Dim fileEnd As String, fileName As String

    Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("بيان نجاح")

    Application.ScreenUpdating = False

    wbPath = ThisWorkbook.Path
    FolderName = "PDF_بيان النجــاح"

    filePath = wbPath & "\" & FolderName & "\"
    If Dir(filePath, vbDirectory) = "" Then
        On Error Resume Next
        MkDir filePath
        On Error GoTo 0
    End If

    fileStart = InputBox("من أي بيان تريد البدء؟", "إدخال رقم البداية")
    fileEnd = InputBox("إلى أي بيان تريد الانتهاء؟", "إدخال رقم النهاية")

    If Not IsNumeric(fileStart) Or Not IsNumeric(fileEnd) Or Len(fileStart) = 0 Or Len(fileEnd) = 0 Then
        MsgBox "الرجاء إدخال أرقام بيانات النجاح صالحة", vbExclamation, "خطأ"
        Application.ScreenUpdating = True
        Exit Sub
    End If

    PagFirst = CLng(fileStart)
    PagEnd = CLng(fileEnd)

    If PagEnd > WS.Range("d1").Value Then
        MsgBox "رقم النهاية يتجاوز عدد الطلاب", vbExclamation, "تحذير"
        Application.ScreenUpdating = True
        Exit Sub
    End If

    If PagFirst > PagEnd Then
        MsgBox "رقم البداية يجب أن يكون أصغر من أو يساوي رقم النهاية", vbExclamation, "خطأ"
        Application.ScreenUpdating = True
        Exit Sub
    End If

    MsgChoose = MsgBox("لطباعة بيانات النجاح إظغط على نعم" & vbCrLf & vbCrLf & _
                        "لحفظ الملفات بصيغة بي دي إف إظغط لا" & vbCrLf & vbCrLf & _
                        "للخروج إظغط على إلغاء", _
                        vbYesNoCancel + vbQuestion, "إختر العملية")

    Select Case MsgChoose
        Case vbYes
            For i = PagFirst To PagEnd
                WS.Range("G1").Value = i
                WS.PrintOut
            Next i
 MsgBox "تم طباعة بيانات النجاح من " & PagFirst & " إلى " & PagEnd, vbInformation
        Case vbNo
            For i = PagFirst To PagEnd
                WS.Range("G1").Value = i
                fileName = Trim(WS.Range("D13").Value)
                If fileName = "" Then
                    fileName = "بيان_" & Format(i, "000")
                End If
                filePath = wbPath & "\" & FolderName & "\" & fileName & ".pdf"
                WS.ExportAsFixedFormat Type:=xlTypePDF, fileName:=filePath
            Next i
            MsgBox "تم حفظ بيانات النجاح من " & PagFirst & " إلى " & PagEnd, vbInformation

        Case vbCancel
            MsgBox "تم إلغاء تنفيذ الكود", vbInformation
    End Select
    Application.ScreenUpdating = True
End Sub

 

بيان نجاح و للكشف درجات.xlsb

[تهانى فكرى]

شكرا خالص ليك استاذ محمد هشام على تعبك و مجهودك جعله الله فى ميزان حسناتك