طلب التعديل على pc في الكود التالي ليصلح لجميع الحواسيب

[hicham2610]

السلام عليكم

من فضلكم

كيف أعدل على pc في الكود التالي ، ليصلح لجميع الحواسيب ، فحاسوبي اسمه: Pc لكن باقي الحواسيب يحدث فشل للكود

Sub Macro5()
'
' Macro5 Macro
'

'
    ActiveSheet.PageSetup.PrintArea = "$AC$7:$AF$50"
'    Range("AC7:AF50").Select
'    Range("AF7").Activate
    ActiveWindow.SmallScroll Down:=-9
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        "C:\Users\pc\Desktop\ÌÏæá ÇáãÊãßäíä äÓÈíÇ.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False
    Application.WindowState = xlMinimized
    Application.WindowState = xlMinimized
    ActiveSheet.PageSetup.PrintArea = ""
     MsgBox "!åÔÇã  : ãÈÑæß Êã ØÈÚ ÇáÌÏæá ÈäÌÇÍ", , Now()
End Sub

وجزاكم الله خيرا

التفييء.xlsm

تم تعديل يوليو 11, 2019 بواسطه hicham2610

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

السلام عليكم

PC فى الكود السابق ليس اسم الجهاز و لكن اسم مستخدم الويندوز

يمكنك نقل الملف الي اي مسار سهل و ذلك باستبدال

"C:\Users\pc\Desktop\ÌÏæá ÇáãÊãßäíä äÓÈíÇ.pdf"

بمسار عام 

مثل

C:\filename.pdf

او

اي مسار اخر لا يقع ضمن مجلد users لان هذا المجلد يحوي مجلدات فرعية لاسماء مستخدمي الويندوز المختلفين

[hicham2610]

السلام عليكم

شكرا لاهتمامك وردك

لكن جربت ولم ينفع معي 

هل من طريقة لإنشاء ملف في مكان تواجد البرنامج ويتم حفظ الملف بصيغة PDF فيه

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

يمكن تحديد موقف الملف الحالي بالكود التالي

Application.ThisWorkbook.Path

 

و بالتالي يصبح اسم الملف فى الكود

MsgBox Application.ThisWorkbook.Path & "\Filename.pdf"

مع استبدال filename

باسم الملف لديك

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

جرب التعديل التالي

Sub Macro5()
CurrentFile = Left(ThisWorkbook.FullName, (InStrRev(ThisWorkbook.FullName, ".", -1, vbTextCompare) - 1))
    ActiveSheet.PageSetup.PrintArea = "$AC$7:$AF$50"
    ActiveWindow.SmallScroll Down:=-9
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        CurrentFile & ".pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Application.WindowState = xlMinimized
    Application.WindowState = xlMinimized
    ActiveSheet.PageSetup.PrintArea = ""
     MsgBox "xxxxxx?", , Now()
End Sub

 

[hicham2610]

جزاك الله خيرا وأحسن إليك

لكن هناك أربعة جداول والتسمية في الكود الجديد يعطيها باسم الملف الأصلي ،لكن تغلبت بهذا الكود على مشكلة مكان الحفظ بحيث يحفظ في مكان تواجد الملف الأصلي

هل من إمكانية حفظ الجداول الأربعة في ملف Pdf واحد

جزاك الله خيرا