تمام نمودارهای فایل اکسس را به PDF تبدیل کنید !

توسط این آموزش و با استفاده ماکروهای ساده می توانید تنها با یک کلیک تمام نمودارهای موجود در فایل اکسل در تمام شیتها را به PDF تبدیل نمائید.

[su_note note_color=”#b5ffc3″]

فهرست و دسترسی سریع

• روش اول ، تبدیل نمودارها به فایلهای جداگانه PDF
• روش دوم ، تبدیل همه نمودارها به یک فایل PDF (پیشنهادی)
• روش سوم ، تبدیل نمودارها به عکسهای جداگانه
• مشاهده ویدیو آموزشی

[/su_note]

[sta_anchor id=”method1″ /]

انتقال تمام نمودارهای موجود در فایل اکسل به فایلهای جداگانه PDF

1- فایل اکسل را باز کنید

2- با زدن کلیدهای Alt + F11 وارد محیط کد نویسی شوید .

3- در فضای خالی سمت چپ کلیک راست نمائید و Insert module کلیک کنید

4- محتویات کد زیر را در آنجا قرار دهید .

5- به محیط اکسل برگردید و یک شکلک Shape درون اکسل قرار دهید .

6- روی شکلک کلیک راست کرده و گزینه OfficebazExportAllGraphsToMultyPDF را انتخاب نمائید.

7- کار تمام است و در محلی که فایل اکسل شما قرار دارد، فایلهای PDF ایجاد شده است .

Sub OfficebazExportAllGraphsToMultyPDF()

    Dim ch As Chart
    Dim objChartObject As ChartObject
    Dim ws As Worksheet
    Dim strExportPath As String
    Dim strFileName As String
    Dim lngWSChartsCount As Long
    Dim lngChartSheetsCount As Long



    strExportPath = ThisWorkbook.Path    'Change if you want different path



    'Export charts from worksheets
    lngWSChartsCount = 0
    For Each ws In Worksheets
    ws.Activate
    


        For Each objChartObject In ws.ChartObjects
            objChartObject.Activate
            Set ch = objChartObject.Chart
            ws.Activate
         
            On Error Resume Next
            strFileName = ch.ChartTitle.Text & ".pdf"
            ch.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strExportPath & "\" & strFileName
            If Err <> 0 Then
                Err.Clear
                strFileName = ch.ChartTitle.Text & ".pdf"
                ch.ExportAsFixedFormat Type:=xlTypePDF, Filename:=strExportPath & "\" & strFileName
                If Err = 0 Then
                    lngWSChartsCount = lngWSChartsCount + 1
                End If
            Else
                lngWSChartsCount = lngWSChartsCount + 1
            End If
            On Error GoTo 0
            strFileName = vbNullString
        Next objChartObject
    Next ws


    
    Call MsgBox(lngWSChartsCount & " charts from worksheets and " & lngChartSheetsCount & " chart sheets exported at " & strExportPath, vbInformation, "Charts Export Result")
End Sub

[sta_anchor id=”method2″ /]

انتقال همه نمودارها به یک فایل PDF

1- مراحل یک تا 4 را طبق روش قبل انجام دهید و از کدهای زیر استفاده نمائید .

2- یک فایل PDF حاوی تمامی نمودارها در مسیر فایل اکسل شما قرار می گیرد .

Sub OfficebazExportAllGraphToOnePdf()
Dim i As Long, j As Long, k As Long
Dim adH As Long
Dim Rng As Range
Dim FilePath As String: FilePath = ThisWorkbook.Path & "\"
Dim sht As Worksheet, shtSource As Worksheet, wk As Worksheet

Sheets.Add After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
ActiveSheet.Name = "ALL"
Set sht = ActiveSheet

'Excluding ALL tab, copying all charts from all tabs to ALL
For Each wk In Worksheets
    If wk.Name <> "ALL" Then
        Application.DisplayAlerts = False
            j = wk.ChartObjects.Count
                For i = 1 To j
                    wk.ChartObjects(i).Activate
                    ActiveChart.ChartArea.Copy
                    sht.Select
                    ActiveSheet.Paste
                    sht.Range("A" & 1 + i & "").Select
                 Next i
        Application.DisplayAlerts = True
    End If
Next


'To set the constant cell vertical increment for separate pages
adH = 40
k = 0
j = sht.ChartObjects.Count

Application.PrintCommunication = True 'this will allow page settings to update
'To set page margins, adding some info about the file location, tab name and date
With ActiveSheet.PageSetup
        .LeftMargin = Application.InchesToPoints(0.7)
        .RightMargin = Application.InchesToPoints(0.7)
        .TopMargin = Application.InchesToPoints(0.75)
        .BottomMargin = Application.InchesToPoints(0.75)
        .HeaderMargin = Application.InchesToPoints(0.3)
        .FooterMargin = Application.InchesToPoints(0.3)
        .Orientation = xlLandscape
        .LeftHeader = "Date generated : " & Now
        .CenterHeader = ""
        .RightHeader = "File name : " & ActiveWorkbook.Name
        .LeftFooter = "File location : " & FilePath & ThisWorkbook.Name
        .CenterFooter = ""
        .RightFooter = ""
        .FitToPagesWide = 1
End With

'adjusting page layout borders
sht.VPageBreaks.Add sht.[N1]
For i = 40 To j * 40 Step 40
sht.HPageBreaks.Add Before:=sht.Cells(i + 1, 1)
Next i
Columns("A:A").EntireRow.RowHeight = 12.75
Rows("1:1").EntireColumn.ColumnWidth = 8.43

For i = 1 To j
Set Rng = ActiveSheet.Range("A" & (1 + k * adH) & " :M" & (40 + k * adH) & "")
    With ActiveSheet.ChartObjects(i)
        .Height = Rng.Height
        .Width = Rng.Width
        .Top = Rng.Top
        .Left = Rng.Left
    End With
    ActiveSheet.PageSetup.PrintArea = "$A$1:$M" & (40 + k * adH) & ""
 k = k + 1
Next i

ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=FilePath & ActiveWorkbook.Name & "." & ActiveSheet.Name, Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

Application.DisplayAlerts = False
ThisWorkbook.Sheets("ALL").Delete
Application.DisplayAlerts = True

Application.ScreenUpdating = True
End Sub

[sta_anchor id=”method3″ /]

روش آخر ، انتقال نمودارها و تبدیل آنها به تصاویر JPG

1- مطابق روشهای قبلی پیش بروید

2- کد های زیر را در فایل اکسل قرار دهید .

   Sub OfficebazExportAllGraphToJPG()

    Dim objShell As Object
    Dim objWindowsFolder As Object
    Dim strWindowsFolder As String
    Dim objSheet As Excel.Worksheet
    Dim objChartObject As Excel.ChartObject
    Dim objChart As Excel.Chart

    'Select a Windows folder
    Set objShell = CreateObject("Shell.Application")
    Set objWindowsFolder = objShell.BrowseForFolder(0, "Select a Windows folder:", 0, "")

    If Not objWindowsFolder Is Nothing Then
       strWindowsFolder = objWindowsFolder.self.Path & "\"

       For i = ThisWorkbook.Worksheets.Count To 1 Step -1
           Set objSheet = ThisWorkbook.Worksheets(i)

           If objSheet.ChartObjects.Count > 0 Then
              For Each objChartObject In objSheet.ChartObjects
                  Set objChart = objChartObject.Chart
                  objChart.Export strWindowsFolder & objChart.Name & ".jpg"
              Next
          End If
       Next

       'Open the windows folder
       Shell "Explorer.exe" & " " & strWindowsFolder, vbNormalFocus
   End If

   End Sub

کسانی که با اکسل آشنایی دارند به راحتی می توانند از ماکروهای بالا استفاده کنند ولی کسانی که حرفه ای نیستند با دیدن ویدیو حتما می توانند انجام دهند 🙂

[sta_anchor id=”video” /]