طباعة اكثر من صفحة

[siso3]

السلام عليكم

المطلوب كود طباعة  كود اطبع بيه الأربع صفحات او اكثر مع بعض مرة واحدة ولكن طباعة النطاق اللى انا احدده 

والنطاق ده هيكون مختلف في كل صفحة

انا مش عايز اطبع اوراق العمل كلها ولا الصفحة كاملة مناطق مختلفة من اكثر من صفطباعة اكثر من صفحة.xlsbحة بكود واحد فقط

 

واخيرا اتقدم بالشكر لحضراتكم لما تقدمونه لا عضاء المنتدى من معلومات قيمة وحلول سريعه

ولما تبذلونه من جهد ملحوظ جعله الله فى ميزان حسانات من نفع وانتفع بعلمه الناس

 

طباعة اكثر من صفحة.xlsb

تم تعديل منذ 13 ساعات بواسطه siso3

[hegazee]

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

Sub PrintOrExportPDF_CustomRanges()
    Dim ws As Worksheet
    Dim rngAddress As String
    Dim sheetNames As Variant
    Dim printableSheetNames() As String
    Dim i As Integer, count As Integer
    Dim printChoice As VbMsgBoxResult
    Dim savePath As String
    Dim fileName As String

    ' أسماء الأوراق (عدّل حسب أوراقك)
    sheetNames = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4")
    count = 0

    ' سؤال المستخدم: طباعة أم PDF؟
    printChoice = MsgBox("هل ترغب في طباعة الأوراق؟" & vbCrLf & "اضغط 'نعم' للطباعة، 'لا' لحفظ كـ PDF.", vbYesNoCancel + vbQuestion, "اختيار نوع الإخراج")

    If printChoice = vbCancel Then
        MsgBox "تم إلغاء العملية.", vbExclamation
        Exit Sub
    End If

    Application.ScreenUpdating = False

    ' تحديد النطاقات
    For i = LBound(sheetNames) To UBound(sheetNames)
        Set ws = ThisWorkbook.Sheets(sheetNames(i))
        rngAddress = InputBox("أدخل النطاق المطلوب طباعته من الورقة: " & sheetNames(i), "تحديد نطاق الطباعة")

        If rngAddress <> "" Then
            On Error Resume Next
            ws.PageSetup.PrintArea = rngAddress
            If Err.Number = 0 Then
                count = count + 1
                ReDim Preserve printableSheetNames(1 To count)
                printableSheetNames(count) = ws.Name
            End If
            On Error GoTo 0
        Else
            MsgBox "تم تخطي الورقة: " & sheetNames(i), vbInformation
        End If
    Next i

    ' تنفيذ العملية حسب الاختيار
    If count > 0 Then
        If printChoice = vbYes Then
            ' ? طباعة مباشرة
            Sheets(printableSheetNames).PrintOut
            MsgBox "تمت طباعة الأوراق المحددة بنجاح.", vbInformation

        ElseIf printChoice = vbNo Then
            ' ? تصدير كـ PDF (بمصنف مؤقت)
            With Application.FileDialog(msoFileDialogFolderPicker)
                .Title = "اختر المجلد لحفظ ملف PDF"
                If .Show <> -1 Then
                    MsgBox "لم يتم اختيار مجلد.", vbExclamation
                    Exit Sub
                End If
                savePath = .SelectedItems(1)
            End With

            fileName = InputBox("أدخل اسم ملف PDF بدون .pdf", "اسم الملف")
            If fileName = "" Then
                MsgBox "لم يتم إدخال اسم الملف.", vbExclamation
                Exit Sub
            End If

            ' إنشاء مصنف مؤقت
            Dim tempBook As Workbook
            Set tempBook = Workbooks.Add

            ' نسخ الأوراق للمصنف المؤقت
            For i = 1 To count
                ThisWorkbook.Sheets(printableSheetNames(i)).Copy After:=tempBook.Sheets(tempBook.Sheets.count)
            Next i

            ' حذف الورقة الافتراضية الفارغة
            Application.DisplayAlerts = False
            Do While tempBook.Sheets.count > count
                tempBook.Sheets(1).Delete
            Loop
            Application.DisplayAlerts = True

            ' حفظ كـ PDF
            tempBook.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                fileName:=savePath & "\" & fileName & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=True

            ' إغلاق المصنف المؤقت بدون حفظ
            tempBook.Close SaveChanges:=False
            MsgBox "تم حفظ ملف PDF بنجاح.", vbInformation
        End If
    Else
        MsgBox "لم يتم تحديد أي ورقة للطباعة أو التصدير.", vbExclamation
    End If

    Application.ScreenUpdating = True
End Sub

 

[siso3]

السلام عليكم

استاذى العزيز Hegazee

اولا شكرا لحضرتك لتعبك واهتمامك

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

وهذا خطأى انا اعلم ذلك

لذلك مرفق الان ملف ارجو من حضرتك تطبيق الكود عليه حتى اتعلم منه مالذى يجب ان اقوم بتغيره ولكي يعمل بصورة جيده

واخيرا شكرا لحضرتك وجزاك الله عنى خيرا

طباعة اكثر من صفحة.xlsb

 

تم تعديل منذ 3 ساعات بواسطه siso3

[hegazee]

تفضل أخي ملفين

الملف الأول: يقوم بطباعة أوراق العمل حسب ما تكتبه من نطاقات في كل رسالة تظهر

الملف الثاني : ما عليك إلا كتابة نطاق طباعة كل صفحة في الخلية A1 و البرنامج يقوم بطباعتها

ملاحظات:

·  إذا اختار المستخدم الطباعة، تطبع جميع الأوراق في دفعة واحدة.

·  إذا اختار حفظ PDF، تنسخ هذه الأوراق إلى مصنف مؤقت ثم يصدر إلى PDF.

*عند التصدير بصيغة PDF اختر مجلد لحفظ ملف الطباعة فيه

*أهم شيء تنسيق الصفحات و الهوامش حيث لاحظت أن بعض الصفحات تتم طباعتها على ورقتين لعدم ضبط المسافات و الحدود

أيضا عند تغيير أسماء أوراق العمل في الملف الأول لابد أن تغيرها في الكود.

 

طباعة اكثر من صفحة.xlsb طباعة اكثر من صفحة من خلال خلية.xlsb