Вставить таблицу Excel в Powerpoint с помощью VBA

Я пытаюсь создать макрос excel, который копирует диаграммы, отображаемые на листе excel, и вставляет их (вставлять специальные) в PowerPoint. Проблема, с которой я сталкиваюсь, - как вставить каждый график на другом слайде? Я не знаю синтаксис вообще ..Вставить таблицу Excel в Powerpoint с помощью VBA

Это то, что я до сих пор (это работает, но это только пасты на первом листе):

Sub graphics3() 

Sheets("Chart1").Select 
ActiveSheet.ChartObjects("Chart1").Activate 
ActiveChart.ChartArea.Copy 
Sheets("Graphs").Select 
range("A1").Select 
ActiveSheet.Paste 
    With ActiveChart.Parent 
    .Height = 425 ' resize 
    .Width = 645 ' resize 
    .Top = 1 ' reposition 
    .Left = 1 ' reposition 
End With 

Dim PPT As Object 
Set PPT = CreateObject("PowerPoint.Application") 
PPT.Visible = True 
PPT.Presentations.Open Filename:="locationwherepptxis" 

Set PPApp = GetObject("Powerpoint.Application") 
Set PPPres = PPApp.activepresentation 
Set PPSlide = PPPres.slides _ 
    (PPApp.ActiveWindow.Selection.SlideRange.SlideIndex) 

' Copy chart as a picture 
ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, _ 
    Format:=xlPicture 

' Paste chart 
PPSlide.Shapes.Paste.Select 

' Align pasted chart 
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True

источник

2011-09-20 thedeepfield

Учитывая я не ваши местоположения файлов для работы с Я приложил подпрограмму ниже этой

Создано нового экземпляра PowerPoint (позднее связывание, следовательно, необходимо определить константы для ppViewSlide и т.д.)
перебирает каждую диаграмму в листе под названием Chart1 (в соответствии с вашим пример)
Добавляет новый слайд
Пасты каждой диаграмму, а затем повторяет

Вы должны форматировать каждое картографическое изображение перед экспортом для размера, или вы можете изменить стандартный размер диаграммы?

Const ppLayoutBlank = 2 
Const ppViewSlide = 1 

Sub ExportChartstoPowerPoint() 
    Dim PPApp As Object 
    Dim chr 
    Set PPApp = CreateObject("PowerPoint.Application") 
    PPApp.Presentations.Add 
    PPApp.ActiveWindow.ViewType = ppViewSlide 
    For Each chr In Sheets("Chart1").ChartObjects 
     PPApp.ActivePresentation.Slides.Add PPApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank 
     PPApp.ActiveWindow.View.GotoSlide PPApp.ActivePresentation.Slides.Count 
     chr.Select 
     ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture 
     PPApp.ActiveWindow.View.Paste 
     PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True 
     PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True 
    Next chr 
    PPApp.Visible = True 
End Sub

источник

2011-09-20 23:30:09 brettdj

+1 Но почему бы не раннее связывание? –

Thx Jean-Francois. Это справедливый вопрос - короткий ответ - личное предпочтение. Как правило, я опоздаю на связывание, если возможны несколько версий автоматизируемого объекта, и, поскольку я обнаружил, что пользователи в форумах Q & A могут бороться с настройками ссылок. В то время как я использовал раннее бинирование в моем Duplicate Master addin, поскольку он привязывается только к библиотеке сценариев файлов, он бреет 20-30% от времени исполнения и как часть дополнения автоматически устанавливается для пользователей. – brettdj

код с функцией для построения диаграмм 6 из Excel в РРТ

Option Base 1 
Public ppApp As PowerPoint.Application 

Sub CopyChart() 

Dim wb As Workbook, ws As Worksheet 
Dim oPPTPres As PowerPoint.Presentation 
Dim myPPT As String 
myPPT = "C:\LearnPPT\MyPresentation2.pptx" 

Set ppApp = CreateObject("PowerPoint.Application") 
'Set oPPTPres = ppApp.Presentations("MyPresentation2.pptx") 
Set oPPTPres = ppApp.Presentations.Open(Filename:=myPPT) 
ppApp.Visible = True 
Set wb = ThisWorkbook 
Set ws = wb.Sheets(1) 

i = 1 

For Each shp In ws.Shapes 

    strShapename = "C" & i 
    ws.Shapes(shp.Name).Name = strShapename 
    'shpArray.Add (shp) 
    i = i + 1 

Next shp 

Call Plot6Chart(oPPTPres, 2, ws.Shapes(1), ws.Shapes(2), ws.Shapes(3), ws.Shapes(4), ws.Shapes(5), ws.Shapes(6)) 

End Sub 
Function Plot6Chart(pPres As Presentation, SlideNo As Long, ParamArray cCharts()) 

Dim oSh As Shape 
Dim pSlide As Slide 
Dim lLeft As Long, lTop As Long 

Application.CutCopyMode = False 
Set pSlide = pPres.Slides(SlideNo) 

For i = 0 To UBound(cCharts) 

    cCharts(i).Copy 
    ppApp.ActiveWindow.View.GotoSlide SlideNo 
    pSlide.Shapes.Paste 
    Application.CutCopyMode = False 


    If i = 0 Then ' 1st Chart 
     lTop = 0 
     lLeft = 0 
    ElseIf i = 1 Then ' 2ndChart 
     lLeft = lLeft + 240 
    ElseIf i = 2 Then ' 3rd Chart 
     lLeft = lLeft + 240 
    ElseIf i = 3 Then ' 4th Chart 
     lTop = lTop + 270 
     lLeft = 0 
    ElseIf i = 4 Then ' 5th Chart 
     lLeft = lLeft + 240 
    ElseIf i = 5 Then ' 6th Chart 
     lLeft = lLeft + 240 
    End If 

    pSlide.Shapes(cCharts(i).Name).Left = lLeft 
    pSlide.Shapes(cCharts(i).Name).Top = lTop 

Next i 

Set oSh = Nothing 
Set pSlide = Nothing 
Set oPPTPres = Nothing 
Set ppApp = Nothing 
Set pPres = Nothing 

End Function

источник

2016-01-09 21:05:11

Вставить таблицу Excel в Powerpoint с помощью VBA

ответ

Смежные вопросы