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

با سلام خدمت دوستان عزیز !
در تاپیکی که با عنوان خطا در اتصال اکسس به اکسل توسط یکی از دوستان گرامی ایجاد شده در ارتباط با موضوع ذخیره فایل اکسل به صورت pdf بحث و نمونه فایل هائی ضمیمه گردیده که بنا به پیشنهاد دوست و استاد گرامی جناب mazoolagh عزیز مبنی بر ایجاد یک تاپیک مستقل بلحاظ سودمند بودن موضوع و همچنین ارتباط موضوع با عنوان تاپیک جهت جستجوی بهتر و راحتتر این تاپیک ایجاد گردید .
بنابراین دوستان گرامی هرگونه سوالی جدیدی که در زمینه تبدیل و ذخیره فایل اکسل به صورت pdf دارند میتوانند آن را در اینجا مطرح نمایند تا ان شاءااله در ارتباط با آن بحث و تبادل نظر شود .
در پناه حق

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

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

همون کد آخر تاپیک اشاره شده رو که شما زحمتش رو کشیدین،
با حذف 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

کد اصلی آقای بهرامی رو هم (که 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

رفرنس:

Workbook.ExportAsFixedFormat method (Excel)

فایل پی ی اف با تاریخ و زمان در کنار فایل اصلی ذخیره بشه ،چندین کاربرگ بطور تجمیعی فقط در یک پی دی اف ذخیره بشه ، چند کاربرگ مختص ورود اطلاعات ،چند کاربرگ مختص محاسبات و لینک داده ها بین کاربرگهای ورود اطلاعات و گزارشات لینک بشه و یه ارور احتمالی دیگه که اگه فایل اکسل مورد نظر به هر نحو از انحا باز بشه برنامه با مشکل پیغام 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.xl  sx")



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\gharard  ad1.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.xl  sx")

    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

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

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

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

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