excel - Excel 或 Powerpoint 2007/2010 中的滚动图表

Question

我有一张图表，它在 X 轴上有大量点。（例如 ECG）。

如何将此图表作为Powerpoint 2007/2010中的水平滚动对象？如果我只是粘贴它，它会调整大小以适应宽度并变得不可读。

我想通过包含图表的水平滚动条来保持高度。

Answer 1

我不确定这是否可以做到。话虽如此，我可以给你一个有趣的选择。:)

假设我们的图表在 Excel 中看起来像这样

右键单击图表并单击Copy。打开 Ms Paint 并粘贴该图片。保存那张照片，说成C:\MyChart.Jpg

接下来打开 MS Powerpoint 并导航到Developer选项卡。（请参阅快照）在开发人员选项卡中，单击附加控件按钮并选择“Microsoft Web 浏览器”并将该控件插入相应的幻灯片中。相应地调整大小。还要放置一个命令按钮。命名它Show Chart或您认为正确的任何其他内容:)

双击命令按钮并将此代码粘贴到那里

Private Sub CommandButton1_Click()
    WebBrowser1.Navigate "C:\MyChart.jpg"
End Sub

现在按F5运行演示文稿。您的屏幕将如下所示。

当你按下命令按钮时，你会得到你想要的:)

这种方法的缺点

1) 您不能在 MS Powerpoint 中编辑图表。您必须在 Excel 中执行此操作并重复整个过程以将其保存为图像。

2) 你不能分发你的PPT。您必须将图像与 PPT 分开发送，并且您必须将命令按钮代码（假设 PPT 和图像位于同一文件夹中）更改为

Private Sub CommandButton1_Click()
    WebBrowser1.Navigate ActivePresentation.Path & "\MyChart.jpg"
End Sub

或者

您必须在 ppt 中嵌入 xls 文件并编写复杂的代码以从 excel 文件中提取图表并将其保存给用户temp directory。然后，您可以在Webbrowser1

Answer 2

由于这从不同的角度解决了问题，因此我发布了一个全新的答案:)

此方法跟进我的最后一条评论

您必须在 ppt 中嵌入 xls 文件并编写复杂的代码以从 excel 文件中提取图表并将其保存到用户临时目录。然后您可以在 Webbrowser1 中使用该图像

跟进

@Siddharth Rout：谢谢！但是，重新分配正是我想要的。而且我不可能将图像作为单独的文件（我要把它交给我的客户）。

你的担心不应该再让你担心了；）

设计模式

在 powerpoint 幻灯片中插入具有图表的 Excel 对象。你的幻灯片应该是这样的

现在如我的其他答案所示，插入“Microsoft Web Browser”和“Command Button”。将 Web 浏览器放在 Excel 对象上方以隐藏它。

你的屏幕现在应该是这样的。

粘贴此代码并运行您的演示文稿......就是这样......真的;）

代码

Option Explicit

Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
(ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const MAX_PATH As Long = 260

Dim ImageFile As String

Private Sub CommandButton1_Click()
    ExtractToTemp
    WebBrowser1.Navigate ImageFile
End Sub

Sub ExtractToTemp()
    Dim oSl As PowerPoint.Slide
    Dim oSh As PowerPoint.Shape

    Dim oXLApp As Object, oXLWB As Object, oXLSht As Object
    Dim mychart As Object

    Set oSl = ActivePresentation.Slides(1)

    Set oSh = oSl.Shapes(1)

    With oSh.OLEFormat.Object.Sheets(1)
        .Shapes(1).Copy
    End With

    '~~> Establish an EXCEL application object
    On Error Resume Next
    Set oXLApp = GetObject(, "Excel.Application")

    If Err.Number <> 0 Then
        Set oXLApp = CreateObject("Excel.Application")
    End If
    Err.Clear
    On Error GoTo 0

    oXLApp.Visible = False

    '~~> Open the relevant file
    Set oXLWB = oXLApp.Workbooks.Add
    Set oXLSht = oXLWB.Worksheets(1)

    oXLSht.Paste

    '~~> Save Picture Object
    ImageFile = TempPath & "Tester.jpg"

    If Len(Dir(ImageFile)) > 0 Then Kill ImageFile

    Set mychart = oXLSht.ChartObjects(1).Chart
    mychart.Export FileName:=ImageFile, FilterName:="jpg"

    '~~> Wait till the file is saved
    Do
        If FileExists(ImageFile) = True Then Exit Do
        DoEvents
    Loop

    '~~> Clean Up And Close Excel
    oXLWB.Close SaveChanges:=False
    oXLApp.Quit

    Set oXLWB = Nothing
    Set oXLApp = Nothing
End Sub

'~~> Get User's TempPath
Function TempPath() As String
    TempPath = String$(MAX_PATH, Chr$(0))
    GetTempPath MAX_PATH, TempPath
    TempPath = Replace(TempPath, Chr$(0), "")
End Function

'~~> Function tot check if file exists
Public Function FileExists(strFullPath As String) As Boolean
    On Error GoTo Whoa
    If Not Dir(strFullPath, vbDirectory) = vbNullString Then FileExists = True
Whoa:
    On Error GoTo 0
End Function

测试示例文件：请下载此文件并运行演示文稿。如果您在单击按钮后看到图表，则表示它有效:)

https://skydrive.live.com/redir.aspx?cid=cdd3f8abe20bbe3b&resid=CDD3F8ABE20BBE3B!162&parid=root