سيد الأكـرت قام بنشر يوليو 2, 2023 مشاركة قام بنشر يوليو 2, 2023 السلام عليكم ورحمة الله وبركاته ارجة المساعدة في كتابة كودين لحفظ الملفات بصيغة بي دي اف بحيث يكون الكود الاول للملفات الخاصة بالأول والثاني والثالث وفيه يتم حفظ الملف بنفس الاسم في نفس مكان وجود الشيت اما الكود الخاص بالرابع والخامس والسادس فايضا يحفظ الكود بنفس اسم الملف مع اتاحة خاصية الاختيار لمكان حفظ الملف بحيث احفظه في المكان الذي ارغب فيه ولكم جزيل الشكر احصاء.xlsx رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يوليو 2, 2023 مشاركة قام بنشر يوليو 2, 2023 وعليكم السلام ورحمة الله تعالى وبركاته هل الملفات يتم حفظها في ورقة pdf واحدة او كل ورقة مستقلة بداتها رابط هذا التعليق شارك More sharing options...
سيد الأكـرت قام بنشر يوليو 2, 2023 الكاتب مشاركة قام بنشر يوليو 2, 2023 (معدل) شكرا لتواصلك اخي الكريم كل ورقة لوحدها اقصد مستقلة بذاتها تم تعديل يوليو 2, 2023 بواسطه سيد الأكـرت رابط هذا التعليق شارك More sharing options...
أفضل إجابة محمد هشام. قام بنشر يوليو 2, 2023 أفضل إجابة مشاركة قام بنشر يوليو 2, 2023 5 ساعات مضت, سيد الأكـرت said: الكود الاول للملفات الخاصة بالأول والثاني والثالث وفيه يتم حفظ الملف بنفس الاسم في نفس مكان وجود الشيت تفضل اخي Sub Save_PDF() 'Save an array of sheets '1/2/3 Dim ws As Variant Dim i As Integer, sh As String Path = ThisWorkbook.Path & "\" Application.ScreenUpdating = False Dim weekSheet As Worksheet For Each ws In Sheets(Array("الأول", "الثاني", "الثالث")) With ws .Activate Set weekSheet = ActiveSheet weekSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & weekSheet.Name & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With Next For i = 1 To 3 sh = sh & Chr(10) & Chr(10) & ThisWorkbook.Sheets(i).Name Next MsgBox "تم حفظ الملفات بنجاح" & sh, vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal, "معلومات" Application.ScreenUpdating = True End Sub 5 ساعات مضت, سيد الأكـرت said: الكود الخاص بالرابع والخامس والسادس فايضا يحفظ الكود بنفس اسم الملف مع اتاحة خاصية الاختيار لمكان حفظ الملف بحيث احفظه في المكان الذي ارغب تفضل استاد Sub Save_PDF2() 'Save an array of sheets '4/5/6 Dim ws As Variant Dim Chemin As String Dim weekSheet As Worksheet With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Title = "اختيار مسار حفظ الملفات" If .Show = -1 Then Chemin = .SelectedItems(1) & "\" For Each ws In Sheets(Array("السادس", "الخامس", "الرابع")) With ws .Activate Application.ScreenUpdating = False Set weekSheet = ActiveSheet weekSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & weekSheet.Name & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False End With Next MsgBox (": تم حفظ الملفات بنجاح في " & vbLf & vbLf & vbLf & .SelectedItems(1)), vbOKOnly + vbInformation + vbDefaultButton1 + vbApplicationModal, "معلومات" Else Exit Sub End If End With Application.ScreenUpdating = True End Sub بالتوفيق .... احصاء V2.xlsb 2 رابط هذا التعليق شارك More sharing options...
سيد الأكـرت قام بنشر يوليو 2, 2023 الكاتب مشاركة قام بنشر يوليو 2, 2023 شكرا جزيلا لحضرتك لكن اذا اتسع صدرك قليلا اولا انا اعمل على اوفيس 2007 وبالتالي الكود لا يعمل معي عليه ثانيا لو امكن وطمعت في كرم حضرتك ممكن يكود الكود عام بحيث اني ممكن استخدمه مع اي ملف بدون الارتباط باسماء الشيتات يعنى كود للحفظ في نفس المكان وكود لاختيار مكان الحفظ ويكون ملف البي دي اف المحفوظ باسم الصفحة تمييزا له عن غيره وأكون شاكرا لحضرتك جدا واسف لتعب حضرتك رابط هذا التعليق شارك More sharing options...
محمد هشام. قام بنشر يوليو 2, 2023 مشاركة قام بنشر يوليو 2, 2023 (معدل) تفضل جرب لاكن لازم الاخد بالاعتبار عند تشغيله على ملف اخر يجب عليك تعديل مكان تموضع الشيتات مثلا هنا حددنا من الشيت الاول الى الشيت الثالث في ترتيب اوراق العمل For i = 1 To Sheets.Count - 3 وهنا حددنا من الشيت الرابع الى اخر شيت على الملف المرفق For i = 4 To Sheets.Count يتبقى لك تعديلهم بما يناسيك Sub SAVE_PDF1() 'Save an array of sheets '1/2/3 Dim Path As String Path = ThisWorkbook.Path & "\" Application.ScreenUpdating = False For i = 1 To Sheets.Count - 3 Sheets(i).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Path & ActiveSheet.Name & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Next MsgBox "تم حفظ الملفات بنجاح" End Sub الكود الثاني Sub SAVE_PDF2() 'Save an array of sheets '4/5/6 Dim Chemin As String Application.ScreenUpdating = False With Application.FileDialog(msoFileDialogFolderPicker) .AllowMultiSelect = False .Title = "اختيار مسار حفظ الملفات" If .Show = -1 Then Chemin = .SelectedItems(1) & "\" Else Exit Sub End If For i = 4 To Sheets.Count Sheets(i).Select ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=Chemin & ActiveSheet.Name & ".pdf", _ Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False Next End With MsgBox "تم حفظ الملفات بنجاح" End Sub احصاء V3.xlsb تم تعديل يوليو 2, 2023 بواسطه محمد هشام. 2 رابط هذا التعليق شارك More sharing options...
سيد الأكـرت قام بنشر يوليو 2, 2023 الكاتب مشاركة قام بنشر يوليو 2, 2023 جزاك الله خيرا وشكرا جزيلا لحضرتك واسف لتعبك 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان