hitech قام بنشر منذ 23 ساعات مشاركة قام بنشر منذ 23 ساعات السلام عليكم ممكن كود لادراج زرار للطباعة واخر لمعاينة الطباعة لورقة فى الاكسيل ولكم جزيل الشكر رابط هذا التعليق شارك More sharing options...
hegazee قام بنشر منذ 21 ساعات مشاركة قام بنشر منذ 21 ساعات و عليكم السلام و رحمة الله و بركاته تفضل أخي الكريم بالملف المرفق زر به كود معاينة و طباعة زر طباعة و معاينة.xlsm 2 رابط هذا التعليق شارك More sharing options...
hitech قام بنشر منذ 20 ساعات الكاتب مشاركة قام بنشر منذ 20 ساعات تمام هستئذن حضرتك ممكن تعديل الكود بحيث يعمل معاينة وطباعة للصفحة اللى واقف فيها مباشرة بدون ما ادخل اسمها نسيت اضيف حاجة مع مراعاة ان الرينج يكون مطاطى رابط هذا التعليق شارك More sharing options...
hegazee قام بنشر منذ 11 ساعات مشاركة قام بنشر منذ 11 ساعات طلبك هنا https://www.officena.net/ib/topic/41803-كود-طباعة-بعد-المعاينة/#google_vignette 1 رابط هذا التعليق شارك More sharing options...
AmirMohamed قام بنشر منذ 3 ساعات مشاركة قام بنشر منذ 3 ساعات تفضل اخي الكريم هذا كود يظهر المعاينه وايضا بعد اغلاق المعاينه يظهر رساله تخيير تصدر اكسل او 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 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان