نحوه تبدیل و ذخیره فایل اکسل به صورت pdf

[eb_1345]

با سلام خدمت دوستان عزیز !
در تاپیکی که با عنوان خطا در اتصال اکسس به اکسل (https://barnamenevis.org/showthread.php?581474-%D8%AE%D8%B7%D8%A7-%D8%AF%D8%B1-%D8%A7%D8%AA%D8%B5%D8%A7%D9%84-%D8%A7%DA%A9%D8%B3%D8%B3-%D8%A8%D9%87-%D8%A7%DA%A9%D8%B3%D9%84) توسط یکی از دوستان گرامی ایجاد شده در ارتباط با موضوع ذخیره فایل اکسل به صورت pdf بحث و نمونه فایل هائی ضمیمه گردیده که بنا به پیشنهاد دوست و استاد گرامی جناب mazoolagh عزیز مبنی بر ایجاد یک تاپیک مستقل بلحاظ سودمند بودن موضوع و همچنین ارتباط موضوع با عنوان تاپیک جهت جستجوی بهتر و راحتتر این تاپیک ایجاد گردید .
بنابراین دوستان گرامی هرگونه سوالی جدیدی که در زمینه تبدیل و ذخیره فایل اکسل به صورت pdf دارند میتوانند آن را در اینجا مطرح نمایند تا ان شاءااله در ارتباط با آن بحث و تبادل نظر شود .
در پناه حق

[simorgh2000]

:تشویق::تشویق::تشویق:

[mazoolagh]

با اجازه آقای بهرامی

همون کد آخر تاپیک اشاره شده رو که شما زحمتش رو کشیدین،
با حذف workbook و به صورت early binding پیوست میکنم :

Dim xlApp As New Excel.Application
Dim ExcelPath As String

ExcelPath = Application.CurrentProject.Path + "\x.xlsx"

With xlApp
.Application.Visible = False
.Workbooks.Open (ExcelPath)
.Sheets(Array("A", "B", "C")).Select
.ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Replace(xlApp, ".xlsx", ".pdf"), _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=True
.Application.Quit
End With
Set xlApp = Nothing

[mazoolagh]

کد اصلی آقای بهرامی رو هم (که late binding هست) همینجا پیوست میکنم تا نیازی به مراجعه به تاپیک دیگه ای نباشه،
و تفاوت دو روش مشخص باشه (برای کسانی که ممکنه براشون سئوال پیش بیاد):

Dim ExcelPath As String
Dim xlAppFTP As Object, xlWb As Object
Set xlAppFTP = CreateObject("Excel.Application")
ExcelPath = Application.CurrentProject.Path + "\x.xlsx"
Set xlWb = xlAppFTP.Workbooks.Open(ExcelPath)
xlAppFTP.Application.Visible = True
xlAppFTP.Sheets(Array("A", "B", "C")).Select
xlAppFTP.ActiveSheet.ExportAsFixedFormat _
Type:=0, FileName:=MyFullName, _
Quality:=1, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=True, _
OpenAfterPublish:=True
xlAppFTP.Application.Quit
Set xlAppFTP = Nothing
Set xlWb = Nothing

[mazoolagh]

رفرنس:

Workbook.ExportAsFixedFormat method (Excel) (https://learn.microsoft.com/en-us/office/vba/api/Excel.Workbook.ExportAsFixedFormat)

[moustafa]

فایل پی ی اف با تاریخ و زمان در کنار فایل اصلی ذخیره بشه ،چندین کاربرگ بطور تجمیعی فقط در یک پی دی اف ذخیره بشه ، چند کاربرگ مختص ورود اطلاعات ،چند کاربرگ مختص محاسبات و لینک داده ها بین کاربرگهای ورود اطلاعات و گزارشات لینک بشه و یه ارور احتمالی دیگه که اگه فایل اکسل مورد نظر به هر نحو از انحا باز بشه برنامه با مشکل پیغام readonly و save مواجهه میشه که باید بهش جواب بده در حالی که نمی خوایم فایل اکسل رو کاربر ببینه برا همین اول بررسی می کنیم و می بندیمش
تابع بررسی باز بودن یک فایل اکسل

Function IsWorkBookOpen(fileName As String)
Dim ff As Long, ErrNo As Long

On Error Resume Next
ff = FreeFile()
Open fileName For Input Lock Read As #ff
Close ff
ErrNo = err
On Error GoTo 0

Select Case ErrNo
Case 0: IsWorkBookOpen = False
Case 70: IsWorkBookOpen = True
Case Else: Error ErrNo
End Select
End Function



اینم نمونه کاملش با ذخیره فایل اکسل جدید در مسیر پروژه

Private Sub Btnamadesazi_Click()
On Error GoTo lab1

Dim Ret, Ret1
Dim xlapp As New Excel.Application
Ret = IsWorkBookOpen("F:\Access\SandHazine\gharardad1.xlsx")

Ret1 = IsWorkBookOpen("F:\Access\SandHazine\khazane.xlsx")

If Ret = True Then
xlapp.Application.Quit

End If

If Ret1 = True Then
xlapp.Application.Quit

End If


DoCmd.OpenForm "frmpdf"

Set wrk = xlapp.Workbooks.Open("F:\Access\SandHazine\gharardad1.xlsx")
Set sheetall = wrk.Sheets(Array("dp", "sh", "tk", "ha", "xv"))
xlapp.Application.Visible = True


X = Shamsi() & "-" & Hour(Now()) & "-" & Minute(Now()) & "-" & Second(Now())
namxl = "Jameh#" & X & "#" & ".xlsx"
nampdf = "F:\Access\SandHazine\Jameh " & X & ".pdf"


wrk.Sheets(Array("dp", "sh", "tk", "ha", "xv")).Select


wrk.ExportAsFixedFormat _
Type:=xlTypePDF, _
fileName:=nampdf, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
From:=1, _
To:=25, _
OpenAfterPublish:=False



Forms!frmpdf!WebBrowserpdf.Navigate (nampdf)
wrk.SaveAs CurrentProject.Path & "\Backup\" & namxl
wrk.Save
wrk.Close False
xlapp.Workbooks.Close
xlapp.Application.Quit
Set wrk = Nothing
Set xlapp = Nothing
Exit Sub
lab1:

MsgBox "ÇÔ˜Çá ÏÑ ÓÇÎÊ ÒÇÑÔ áØÝÇ ãÌÏÏÇ ÊáÇÔ äãÇÆíÏ", , "ÎØÇ"
Dim Ret2, Rte3

Ret2 = IsWorkBookOpen("F:\Access\SandHazine\gharardad1.xlsx")
Ret3 = IsWorkBookOpen("F:\Access\SandHazine\khazane.xlsx")
If Ret2 = True Then



xlapp.Application.Quit
MsgBox "khazane.xlsx closed"
End If


If Ret3 = True Then


xlapp.Application.Quit


End If
DoCmd.Close acForm, "frmpdf"
Exit Sub


End Sub

[moustafa]

قبلش باید فایلهای باز بسته بشه آخرش هم اگه به نحوی دچار خطا بشه که پی دی اف نسازه فایل اکسل باز شده باید بسته بشه که دچار خرابکاری و اشغال حافظه نشه . نوشتن کدهای تمیز با رعایت تو رفتگی ،گذاشتن کامنت برای مراجعات بعدی یا شناخت مسیر یا علت ،خالی کردن متغیرها برای جلوگیری از اشغال حافظه ،گذاشتن انیمیشن و ..تا زمان ساخت پی دی اف پیشنهاد میشه

[moustafa]

از اونجائیکه ممکن فایل اکسل در مسیرهای مختلف کپی بشه من از یک مسیر ثابت استفاده کردم که فایل اکسل موجود در اون در صورت ویرایش و دادن اطلاعات مورد بازخوانی قرار بگیره

[moustafa]

اگه کاربرگی مخفی باشه از اون گزارش ساخته نمیشه بنابراین قبلش باید ظاهر بشه

wrk.Sheets("dp").visible=ture