طلب مساعدة في كتابة كود طباعة كل الشيتات على صيغة PDF

[محمد مصطفى درويش]

السلام عليكم اخواني 

مرفق ملف العمل اكسل اريد كتابة كود طباعة كل الشيتات ابتداء من الشيت المسمى البطاقة1 وانتهاء بالشيت المسمى الصف الثاني60 علما ان عدد الشيتات المراد طباعتها بصيغة PDF عددها 120 شيت شاكرا جهودكم  علما ان كود حماية الماكرو هو 12310

 

ملاحظة : تم اعادة رفع الملف فى مشاركة لاحقة

 

[محمد طاهر عرفه]

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

لم ينجح معي فك ضغط الملف

و لكن بصفة عامة اذا كان المطلوب طباعة كافة الشيتات الي بي دي اف او غيره ، يمكن تنفيذ طباعة كافة اوراق العمل اوبعضها مباشرة دون اكواد ، و ذلك عن طريق:
- خيار طباعة كافة اوراق العمل

- خيار طباعة بعض اوراق العمل ، عن طريق اختيار الاوراق المطلوبة اولا ثم

 

[محمد مصطفى درويش]

بارك الله في جهودك استاذ محمد عرفة هناك شيتات لا ارغب في طباعتها والا لكنت اخترت هذا الامر الذي ذكرت ، ارفق اليك ملف العمل دون ضغط ملف شاكرا جهودا يمكنك تجميل الملف من هذا الرابط https://drive.google.com/drive/folders/1jPQGWqw-994KYYoJpeA1QBylm5bg9pVa?usp=sharing

تم تعديل يونيو 22, 2023 بواسطه محمد مصطفى درويش

[محمد هشام.]

أستاذ مصطفى حاول أولا تنسيق  حدود الطباعة للشيتات المراد طباعتها

2) هل تريد حفظ الشيتات بصيغة Pdf في مكان معين وطباعتها في نفس الوقت او الحفظ فقط

[محمد مصطفى درويش]

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

[محمد هشام.]

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

Sub Save_PDF()
Dim i As Byte
Path = ThisWorkbook.Path & "\"
temps = Timer
Application.ScreenUpdating = False
Dim weekSheet As Worksheet
For i = 8 To Worksheets.Count
With Sheets(i).Select
   
   Set weekSheet = ActiveSheet
  
  weekSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & weekSheet.Name & ".pdf", _
  Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
            
     
     End With
Next
Sheet1.Activate
Application.ScreenUpdating = True

MsgBox "تم حفظ" & " " & Application.Sheets.Count - 7 & " " & "بطاقة " & "-" & "تم تنفيد الكود في: " & Format(Timer - temps, "0.0000") & "ثانية", Exclamation, "Officena"
End Sub

 

ملف الطالب.rar

[محمد مصطفى درويش]

بارك الله في علمك وعملك ووفقك الله أخي الكريم ، اعذرني أخي الكريم لعلي لم أفهم قصدك بردك السابق (هل تريد حفظ الشيتات بصيغة Pdf في مكان معين وطباعتها في نفس الوقت او الحفظ فقط) انما كل ما اريده ان يقوم الكود بحفظها بهذا الشكل ان أمكن شاكرا تعبك معي في هذه الايام الفضيلة كما في الملف المرفق التالي 

بطاقات الصف الثاني.pdf

تم تعديل يونيو 23, 2023 بواسطه محمد مصطفى درويش

[محمد هشام.]

تفضل استاد  @محمد مصطفى درويش  

 

Public Sub SAVE_PDF()
  Dim SH          As Worksheet
  Dim WSdest      As String
  Dim wsName      As Variant
  
  Const cstrDel As String = ","
  
  Application.ScreenUpdating = False
   For Each SH In Worksheets
    If SH.Index >= 8 Then
      WSdest = WSdest & SH.Name & cstrDel
    End If
  Next SH
'
  
'PDF اسم ملف
  wsName = "البطاقات"
    
    Worksheets(Split(Left(WSdest, Len(WSdest) - 1), cstrDel)).Select
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ThisWorkbook.Path & "\" & wsName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
 
        Sheet1.Select
        Application.ScreenUpdating = True
  MsgBox "تم حفظ" & " " & Application.Sheets.Count - 7 & " " & "بطاقة ", Exclamation, "officena"
End Sub

 

ملف الطالب 2.rar

[محمد مصطفى درويش]

 بارك الله في عمرك يا اخي الكريم اشكرك من كل قلبي وجزاك الله عمن أخدمهم بهذا البرنامج ، لك اجرهم كصدقة جارية ان شاء الله