المطلوب تغيير اسم حفظ الملف PDF حسب تغيير محتوى خليه F3

[mohmod zedan]

المطلوب تغيير اسم حفظ الملف PDF حسب تغيير محتوى خليه F3

 

كود.xlsb

[حسونة حسين]

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

عدل السطر الى

sNewFilePath = ThisWorkbook.Path & "\" & Range("F3").text & ".pdf"

 

[mohmod zedan]

خطأ

تم تعديل أبريل 26, 2024 بواسطه mohmod zedan

[محمد هشام.]

جرب هدا 

Dim sFile As String
sFile = Range("F3").Value
sNewFilePath = ThisWorkbook.Path & "\"

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=sNewFilePath & sFile & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

مجرد تخمين ربما يفيدك

Sub General()
Dim LatR As Long:
Dim sFile As String
Set WS = ActiveSheet:     sFile = [F3].Value
 
LatR = Range("a:a").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

WS.PageSetup.PrintArea = Range("A2:AF" & LatR).Rows.SpecialCells(xlCellTypeVisible).Address
 WS.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
sNewFilePath = ThisWorkbook.Path & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=sNewFilePath & sFile & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Sheets("النتيجة2").Select

End Sub

 

[mohmod zedan]

خطأ في الكود

 

[محمد هشام.]

ربما لو قمت بارفاق الملف سوف تكون الامور اوضح 

تفضل جرب

Sub General()
Dim LatR As Long:
Dim sFile As String
Set WS = ActiveSheet:     sFile = [F3].Value
On Error Resume Next
LatR = Range("A:A").Find("*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
With WS

.PageSetup.PrintArea = Range("A2:AF" & LatR).Rows.SpecialCells(xlCellTypeVisible).Address
.VPageBreaks(1).DragOff Direction:=xlToRight, RegionIndex:=1
sNewFilePath = ThisWorkbook.Path & "\"
.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=sNewFilePath & sFile & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
End With
Sheets("النتيجة2").Select

End Sub

 

 

 

TEST PDF.xlsb

تم تعديل أبريل 26, 2024 بواسطه محمد هشام.

[mohmod zedan]

@محمد هشام.

الملف مرفق بالفعل كود.xlsb

[حسونة حسين]

تفضل لان الخليه f3 بها تاريخ ظهر لك هذا الخطأ

sNewFilePath = ThisWorkbook.Path & "\" & Replace(Range("F3").text, "/", "-") & ".pdf"

 

[محمد هشام.]

17 دقائق مضت, mohmod zedan said:

الملف مرفق بالفعل

اسف اخي لم انتبه فعلا على العموم حل الاستاد حسونة سوف يلبي المطلوب 

بالتوفيق.