Прокручиваемая диаграмма в Excel или Powerpoint 2007/2010

Я не уверен, можно ли это сделать. Сказав это, я могу предложить вам интересную альтернативу. :)

Допустим, наша диаграмма выглядит так в Excel

Щелкните правой кнопкой мыши на графике и выберите Copy. Откройте Ms Paint и вставьте эту картинку. Сохраните это изображение, скажем, как C:\MyChart.Jpg

Затем откройте MS Powerpoint и перейдите на вкладку Developer. (См. Снимок) На вкладке разработчика нажмите кнопку дополнительных элементов управления, выберите «Веб-браузер Microsoft» и вставьте этот элемент управления в соответствующий слайд. Размер его соответственно. Также поместите кнопку управления. Назовите его 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

ИЛИ

Вам нужно будет вставить файл xls в ppt и написать сложный код, чтобы извлечь диаграмму из файла excel и сохранить ее для пользователей temp directory. Затем вы можете использовать это изображение в Webbrowser1

Поскольку это подошло к проблеме под другим углом, я публикую совершенно новый ответ :)

Этот метод следует за моим последним комментарием

Вам нужно будет встроить файл xls в ppt и написать сложный код, чтобы извлечь диаграмму из файла excel и сохранить ее во временном каталоге пользователя. Затем вы можете использовать это изображение в Webbrowser1

ПОСЛЕДУЮЩИЕ

@Siddharth Rout: Спасибо! Но перераспределение — это именно то, чего я хочу. И я не могу иметь изображение в виде отдельного файла (я должен передать его моему клиенту).

Ваши заботы больше не должны вас беспокоить ;)

РЕЖИМ ДИЗАЙНА

В слайд PowerPoint вставьте объект Excel с диаграммой. Ваш слайд должен выглядеть так

Теперь, как показано в моем другом ответе, вставьте «Веб-браузер Microsoft» и «Кнопку управления». Поместите веб-браузер над объектом 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