Note: The other languages of the website are Google-translated. Back to English

如何將單個或所有圖表從Excel工作表導出到PowerPoint?

有時,出於某些目的,您可能需要將圖表或所有圖表從Excel導出到PowerPoint。 本文討論的是如何實現它。

使用VBA代碼將單個圖表或所有圖表從Excel工作表導出到PowerPoint


使用VBA代碼將單個圖表或所有圖表從Excel工作表導出到PowerPoint

本節將介紹VBA代碼,以將單個圖表或所有圖表從工作簿導出到PowerPoint。 請執行以下操作。

1。 按 其他 + F11 鑰匙一起打開 Microsoft Visual Basic for Applications 窗口。

2。 在裡面 Microsoft Visual Basic for Applications 窗口中,單擊 工具 > 參考 如下圖所示。

3。 在裡面 參考– VBAProject 對話框中,向下滾動以查找並檢查 Microsoft PowerPoint對像庫 選項,然後單擊 OK 按鈕。 看截圖:

4。 然後點擊 插入 > 模塊.

5.如果要將單個圖表導出到PowerPoint,請轉到在工作表中選擇圖表,然後返回到 Microsoft Visual Basic for Applications 窗口,將下面的VBA代碼複製並粘貼到“模塊”窗口中。

VBA代碼:將單個圖表從Excel工作表導出到PowerPoint

Sub SingleActiveChartToPowerPoint_EarlyBinding1()
'Updated by Extendoffice 2017/9/15
  Dim pptApp As PowerPoint.Application
  Dim pptPres As PowerPoint.Presentation
  Dim pptSlide As PowerPoint.Slide
  Dim pptShape As PowerPoint.Shape
  Dim pptShpRng As PowerPoint.ShapeRange
  Dim xActiveSlideNow As Long
  On Error Resume Next
  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again!", vbExclamation, "KuTools For Excel"
    Exit Sub
  End If
  Set pptApp = GetObject(, "PowerPoint.Application")
  If pptApp Is Nothing Then
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPres = pptApp.Presentations.Add
    Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
  Else
    If pptApp.Presentations.Count > 0 Then
      Set pptPres = pptApp.ActivePresentation
      If pptPres.Slides.Count > 0 Then
        xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
        Set pptSlide = pptPres.Slides(xActiveSlideNow)
      Else
        Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
      End If
    Else
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    End If
  End If
  ActiveChart.ChartArea.Copy
  With pptSlide
    .Shapes.Paste
    Set pptShape = .Shapes(.Shapes.Count)
    Set pptShpRng = .Shapes.Range(pptShape.Name)
  End With
  With pptShpRng
    .Align msoAlignCenters, True
    .Align msoAlignMiddles, True
  End With
  pptShpRng.Select
End Sub

如果要從工作簿中導出所有圖表,請複制以下VBA代碼並將其粘貼到“模塊”窗口中。

VBA代碼:將所有圖表從Excel工作表導出到PowerPoint

Option Explicit
'Updated by Extendoffice 2017/9/15
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Sub ChartsToPowerPoint()
    Dim xSheet As Worksheet
    Dim xChartsCount As Integer
    Dim xChart As Object
    Dim xActiveSlideNow As Integer
    On Error Resume Next
    For Each xSheet In ActiveWorkbook.Worksheets
        xChartsCount = xChartsCount + xSheet.ChartObjects.Count
    Next xSheet
    If xChartsCount = 0 Then
        MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
        Exit Sub
    End If
    Set pptApp = GetObject(, "PowerPoint.Application")
    If pptApp Is Nothing Then
      Set pptApp = CreateObject("PowerPoint.Application")
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    Else
        If pptApp.Presentations.Count > 0 Then
          Set pptPres = pptApp.ActivePresentation
          If pptPres.Slides.Count > 0 Then
            xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
            Set pptSlide = pptPres.Slides(xActiveSlideNow)
          Else
            Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
          End If
        Else
          Set pptPres = pptApp.Presentations.Add
          Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
        End If
    End If
    For Each xSheet In ActiveWorkbook.Worksheets
        For Each xChart In xSheet.ChartObjects
            Call pptFormat(xChart.Chart)
        Next xChart
    Next xSheet
    For Each xChart In ActiveWorkbook.Charts
        Call pptFormat(xChart)
    Next xChart
    
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "KuTools For Excel"
End Sub
Private Sub pptFormat(xChart As Chart)
    Dim xCharTiTle As String
    Dim I As Integer
    On Error Resume Next
    xCharTiTle = xChart.ChartTitle.Text
    xChart.ChartArea.Copy
    pptSlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
    pptSlide.Select
    pptSlide.Shapes.PasteSpecial ppPasteJPG
    If xCharTiTle <> "" Then
        pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
    End If
    For I = 1 To pptSlide.Shapes.Count
        With pptSlide.Shapes(I)
            Select Case .Type
                Case msoPicture:
                    .Top = 87.84976
                    .left = 33.98417
                    .Height = 422.7964
                    .Width = 646.5262
                Case msoTextBox:
                    With .TextFrame.TextRange
                        .ParagraphFormat.Alignment = ppAlignCenter
                        .Text = xCharTiTle
                        .Font.Name = "Tahoma (Headings)"
                        .Font.Size = 28
                        .Font.Bold = msoTrue
                    End With
                End Select
        End With
    Next I
End Sub

6。 按 F5 鍵或單擊“運行”按鈕以運行代碼。 然後將打開一個新的PowerPoint,其中包含選定的圖表或所有導入的圖表。 你會得到一個 Excel的Kutools 對話框如下圖所示,請點擊 OK 按鈕。


相關文章:


最佳辦公效率工具

Kutools for Excel 解決了你的大部分問題,並將你的生產力提高了 80%

  • 重用: 快速插入 複雜的公式,圖表 以及您以前使用過的任何東西; 加密單元 帶密碼 創建郵件列表 並發送電子郵件...
  • 超級公式欄 (輕鬆編輯多行文本和公式); 閱讀版式 (輕鬆讀取和編輯大量單元格); 粘貼到過濾範圍...
  • 合併單元格/行/列 不會丟失數據; 拆分單元格內容; 合併重複的行/列...防止細胞重複; 比較範圍...
  • 選擇重複或唯一 行; 選擇空白行 (所有單元格都是空的); 超級查找和模糊查找 在許多工作簿中; 隨機選擇...
  • 確切的副本 多個單元格,無需更改公式參考; 自動創建參考 到多張紙; 插入項目符號,複選框等...
  • 提取文字,添加文本,按位置刪除, 刪除空間; 創建和打印分頁小計; 在單元格內容和註釋之間轉換...
  • 超級濾鏡 (將過濾方案保存並應用於其他工作表); 高級排序 按月/週/日,頻率及更多; 特殊過濾器 用粗體,斜體...
  • 結合工作簿和工作表; 根據關鍵列合併表; 將數據分割成多個工作表; 批量轉換xls,xlsx和PDF...
  • 超過 300 項強大的功能. 支持 Office / Excel 2007-2021 和 365。支持所有語言。 在您的企業或組織中輕鬆部署。 完整功能 30 天免費試用。 60 天退款保證。
kte選項卡201905

Office選項卡為Office帶來了選項卡式界面,使您的工作更加輕鬆

  • 在Word,Excel,PowerPoint中啟用選項卡式編輯和閱讀,發布者,Access,Visio和Project。
  • 在同一窗口的新選項卡中而不是在新窗口中打開並創建多個文檔。
  • 將您的工作效率提高 50%,每天為您減少數百次鼠標點擊!
officetab底部
按評論排序
留言 (7)
還沒有評分。 成為第一位評論!
網站主持人對此評論進行了最小化
謝謝,您的代碼非常適合我需要做的事情。 我會將您的頁面添加為書籤,並在需要更多信息時回來。
網站主持人對此評論進行了最小化
嗨,謝謝你的代碼。

我嘗試通過一些更改來更新您的代碼,但我不知道該怎麼做,我需要更新/更改特定幻燈片上的某些形狀,但我不知道該怎麼做。?
網站主持人對此評論進行了最小化
嗨安東尼,
抱歉還不能幫你。 謝謝你的評論。
網站主持人對此評論進行了最小化
您好,
我怎樣才能在 PDF 中有一些東西?

謝謝 !
網站主持人對此評論進行了最小化
嗨,

我試圖運行你的代碼,但是雖然它向我拋出了這條消息,但它並沒有打開任何 powerpoint,也沒有拋出任何錯誤。
圖表應該在一個唯一的工作表中,或者如果它們一起在一個工作表中沒有問題?

謝謝。
網站主持人對此評論進行了最小化
嗨,安德烈亞斯,
您可以通過選擇並運行第一個代碼來導出單個圖表。
或者使用第二個代碼導出工作簿中的所有圖表。
感謝您的評論。
網站主持人對此評論進行了最小化
您好,您的代碼與我所做的非常相似,但我有一個問題,我如何粘貼圖形但我可以編輯 power point 文件中的數據?
這裡還沒有評論
留下你的意見
以訪客身份發帖
×
評價此帖子:
0   字符
推薦地點

關注我們

版權所有©2009 - 萬維網。extendoffice.com。 | 版權所有。 供電 ExtendOffice。 |
Microsoft和Office徽標是Microsoft Corporation在美國和/或其他國家的商標或註冊商標。
受Sectigo SSL保護