Sub ertert() With New PowerPoint.Application With .Presentations.Add With .Slides.Add(1, 12) ActiveSheet.ChartObjects(1).CopyPicture xlPrinter, xlPicture .Shapes.Paste .Shapes(1).Select .Application.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True .Application.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True End With End With End With End Sub
Sub ertert() With New PowerPoint.Application With .Presentations.Add With .Slides.Add(1, 12) ActiveSheet.ChartObjects(1).CopyPicture xlPrinter, xlPicture .Shapes.Paste .Shapes(1).Select .Application.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True .Application.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True End With End With End With End Sub
Public Sub InsertChartToPowerPoint(ByVal this As ChartObject) Dim pApp As New PowerPoint.Application, pShape As PowerPoint.ShapeRange pApp.Visible = msoTrue this.Copy With pApp.Presentations.Add(msoTrue).Slides.Add(1, 12) Set pShape = .Shapes.PasteSpecial(ppPasteShape) pShape.Align MsoAlignCmd.msoAlignCenters, msoTrue pShape.Align MsoAlignCmd.msoAlignMiddles, msoTrue End With End Sub
Public Sub test() InsertChartToPowerPoint ActiveSheet.ChartObjects(1) End Sub
[/vba] Успехов
Доброе время суток
Цитата
а обыкновенной диаграммой со связью с источником
Да точно также, только меняется тип вставки [vba]
Код
Public Sub InsertChartToPowerPoint(ByVal this As ChartObject) Dim pApp As New PowerPoint.Application, pShape As PowerPoint.ShapeRange pApp.Visible = msoTrue this.Copy With pApp.Presentations.Add(msoTrue).Slides.Add(1, 12) Set pShape = .Shapes.PasteSpecial(ppPasteShape) pShape.Align MsoAlignCmd.msoAlignCenters, msoTrue pShape.Align MsoAlignCmd.msoAlignMiddles, msoTrue End With End Sub
Public Sub test() InsertChartToPowerPoint ActiveSheet.ChartObjects(1) End Sub