Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Импорт диаграммы из PowerPoint в Excel
 
#1
09.01.2016 14:29:36
Добрый день!
Помогите решить проблему:
Есть презентация PowerPoint с диаграммой, импортированной из Excel. Источник (книга Excel) диаграммы утерян, и теперь требуется вставить диаграмму из PowerPoint обратно в Excel для последующего извлечения из нее данных в табличную форму.
Изменено: spr!nter - 09.01.2016 15:06:05 (несоответствие правилам)
 
 
 
#2
09.01.2016 14:55:48
Цитата
spr!nter написал: ... и теперь требуется...
Самая малость - усвоить правила, включить поиск и приложить пример согласно п.2.3.
ps Одна тема - один вопрос, а вам требуется решить два - вернуть в XL и извлечь. Сами что-то можете сделать?.. ;)
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
 
 
#3
09.01.2016 15:08:27
Вопрос подкорректировал, а пример даже с одним графиком, к сожалению, превышает допустимые 100 Кб.
 
 
 
#4
09.01.2016 16:11:35
Доброе время суток
Коль файла нет. Попробуйте адаптировать под себя Перенос объекта Excel из Word в Excel. Он хоть и для Word, но, думаю, принцип где-то тот же.
Upd. Если файл у вас нового формата pptx, то можно получить данные диаграммы из файлов вида ppt\charts\chartXX.xml - просто разобрать содержимое xml.
Успехов.
Изменено: Андрей VG - 09.01.2016 17:04:05
 
 
 
#5
09.01.2016 18:02:06
 В VBE в файле PPT устанавливаем ссылку на библиотеку Microsoft Excel  # Object Library (где # - номер версии) и оперируем объектами Excel вот так:

Код
Sub GET_XL_FROM_PPT()
     Dim XLObj As Excel.Workbook
     Set XLObj = ActivePresentation.Slides(1).Shapes("МойОбъект").OLEFormat.Object
     With XLObj
         MsgBox .Worksheets(1).UsedRange.Address
         .SaveAs ActivePresentation.Path & "\Test"
     End With
 End Sub
KL
 
 
 
#6
10.01.2016 05:41:59
Доброе время суток.
С диаграммами в Power Point можно работать точно так же как в Excel через объект Chart. В примере в Immediate выводятся координаты точечной диаграммы, вставленной на слайд из Excel.

Успехов.
 
 
 
#7
21.03.2024 12:05:07
Скрипт берёт с первого листа первую диаграмму и сохраняет данные в таблицу Excel.
В прилагаемом файле пример.
Код
Option Explicit
' Скрипт для преобразования диаграммы в PowerPoint в Таблицу Excel.
' Для работы скрипта включить (поставить галку) в VBA в главном меню:
' Tools -> References -> Microsoft Excel 15.0 Object Library
Sub From_Powerpoint_to_Excel()

' Номера слайда, фигуры, количество рядов (графиков) в PowerPoint.
' j - служебная переменная цикла
Dim SlideNum, ShapeNum, Collection, j As Integer
    SlideNum = 1
    ShapeNum = 1
    Collection = 3
    
' Номера строки, колонки, листа Excel.
Dim Rw, StCol, Col, Sht As Long
    Rw = 2     'Starting Row of Target excel data
    StCol = 2   'Starting Column of Target excel data
    Sht = 1   'Target Worksheet no.
    
Dim XLObj As Excel.Workbook
'Текущий путь
Dim sCurrentPath As String
sCurrentPath = ActivePresentation.Path
'Создаем новую книгу
Workbooks.Add
Set XLObj = ActiveWorkbook

'----- Основная часть
Dim pChart As Chart, Xs, Ys, i As Long, pSeries As Series
    ' Получаем данные из диаграммы
    Set pChart = ActivePresentation.Slides(SlideNum).Shapes(ShapeNum).Chart
    
    For j = 1 To Collection
    Set pSeries = pChart.SeriesCollection(j)
    Xs = pSeries.XValues: Ys = pSeries.Values
    ' Пишем заголовки
    XLObj.Sheets(Sht).Cells(1, 2).Value = "Данные для графика"
    XLObj.Sheets(Sht).Cells(Rw, StCol).Value = "X"
    XLObj.Sheets(Sht).Cells((Rw + 1), StCol).Value = "Y"
    StCol = StCol + 1
        ' Проходим по массиву данных из диаграммы
        For i = LBound(Xs) To UBound(Xs)
            ' Отладка
            Debug.Print "Point " & CStr(i) & " X = " & CStr(Xs(i)) & ", Y = " & CStr(Ys(i))
            ' Запись значений в ячейки чисел с десятичными дробями.
            'XLObj.Sheets(Sht).Cells(Rw, StCol).Value = CDbl(CStr(Xs(i)))
            'XLObj.Sheets(Sht).Cells((Rw + 1), StCol).Value = CDbl(CStr(Ys(i)))
            ' Запись значений в ячейки в виде строк.
            XLObj.Sheets(Sht).Cells(Rw, StCol).Value = CStr(Xs(i))
            XLObj.Sheets(Sht).Cells((Rw + 1), StCol).Value = CStr(Ys(i))
            StCol = StCol + 1
        Next i
        Rw = Rw + 2
        StCol = 2
    Next j
'-----
'Сохраняем книгу в папку, где расположен файл с кодом
ActiveWorkbook.SaveAs (sCurrentPath & "\Table1.xlsx")
'Закрываем файл
ActiveWorkbook.Close
MsgBox "Макрос заверщён. Реультат в файле Table1.xlsx"
End Sub
 
 
 
Страницы: 1
Читают тему
Наверх