استفسار بخصوص الطباعة

[hitech]

السلام عليكم

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

[hegazee]

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

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

زر طباعة و معاينة.xlsm

[hitech]

تمام هستئذن حضرتك ممكن تعديل الكود بحيث يعمل معاينة وطباعة للصفحة اللى واقف فيها مباشرة بدون ما ادخل اسمها

 

نسيت اضيف حاجة مع مراعاة ان الرينج يكون مطاطى

[hegazee]

طلبك هنا

https://www.officena.net/ib/topic/41803-كود-طباعة-بعد-المعاينة/#google_vignette

 

[AmirMohamed]

تفضل اخي الكريم

هذا كود يظهر المعاينه وايضا بعد اغلاق المعاينه يظهر رساله تخيير تصدر اكسل او PDF 🙂  

أنشئ موديول وضيف فيه هذا الكود :

Sub printpreview1()
    ThisWorkbook.Windows(1).Visible = True
    Application.Visible = True

    Dim lastRow As Long
    Dim lastColumn As Long
    Dim ws As Worksheet
    Dim response As VbMsgBoxResult
    
    ' تحديد ورقة العمل المطلوبة
    Set ws = ThisWorkbook.Sheets("sheet")
    
    ' العثور على آخر صف وعمود يحتويان على بيانات
    lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    lastColumn = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column

    If lastRow > 0 And lastColumn > 0 Then
        ' إعداد منطقة الطباعة
        With ws
            .PageSetup.PrintArea = .Cells(1, 1).Resize(lastRow, lastColumn).Address
            .PrintPreview
        End With
        
        ' عرض رسالة خيارات التصدير
        Dim exportChoice As Integer
        exportChoice = MsgBox("اختر نوع التصدير:" & vbCrLf & _
                              "نعم - تصدير إلى Excel" & vbCrLf & _
                              "لا - تصدير إلى PDF" & vbCrLf & _
                              "إلغاء - للخروج", _
                              vbYesNoCancel + vbQuestion, "تصدير البيانات")
        
        Select Case exportChoice
            Case vbYes
                ' تصدير إلى Excel
                Dim newWorkbook As Workbook
                Set newWorkbook = Workbooks.Add
                ws.Cells.Copy Destination:=newWorkbook.Sheets(1).Cells(1, 1)

                Dim excelPath As String
                excelPath = Application.GetSaveAsFilename(InitialFileName:=".xlsx", FileFilter:="Excel Files (*.xlsx), *.xlsx")
                
                If excelPath <> "False" Then
                    newWorkbook.SaveAs excelPath
                    MsgBox "تم تصدير البيانات بنجاح إلى Excel!"
                Else
                    MsgBox "تم إلغاء عملية التصدير"
                End If
                
                newWorkbook.Close SaveChanges:=False
            
            Case vbNo
                ' تصدير إلى PDF
                Dim pdfPath As String
                pdfPath = Application.GetSaveAsFilename(InitialFileName:="Document.pdf", FileFilter:="PDF Files (*.pdf), *.pdf")
                
                If pdfPath <> "False" Then
                    ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=pdfPath, Quality:=xlQualityStandard
                    MsgBox "تم تصدير البيانات بنجاح إلى PDF!"
                Else
                    MsgBox "تم إلغاء عملية التصدير"
                End If
                
            Case vbCancel
                MsgBox "تم إلغاء عملية التصدير"
        End Select
    Else
        MsgBox "لا توجد بيانات للتصدير."
    End If
End Sub

 

[hitech]

تمام استاذنا وهذا ما اريده بس هستئذن حضرتك ممكن تعديل على الكود بحيث يتم الغاء رساله تخيير تصدر اكسل او PDF

[AmirMohamed]

Sub printpreview1()
    On Error GoTo ErrorHandler

    ThisWorkbook.Windows(1).Visible = True
    Application.Visible = True

    Dim lastRow As Long
    Dim ws As Worksheet
    
    ' تحديد ورقة العمل المطلوبة
    Set ws = ThisWorkbook.Sheets("sheet")
    
    ' العثور على آخر صف يحتوي على بيانات
    lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

    If lastRow > 0 Then
        ' إعداد منطقة الطباعة لتشمل كل الأعمدة
        With ws
            .PageSetup.PrintArea = .Cells(1, 1).Resize(lastRow, ws.Columns.Count).Address
            .PrintPreview
        End With
    End If

    Exit Sub

ErrorHandler:
    MsgBox "حدث خطأ: " & Err.Description, vbExclamation, "خطأ"
End Sub

تمام تفضل اخي الكريم

تم تعديل أكتوبر 1 بواسطه AmirMohamed