Transfer charts to Power Point 1

[easycode]

Hello
I have many charts done in access (like 60 charts done in monthly basis and using differents tables and queries) and i need to transfer it automatically in power point. Is there any way to do this by code?

Thanks

 

[SkipVought]

Hi,

Here's some code I use in Excel do copy charts to an open ppt.

Sub CopyCharts()
    Dim i As Integer, n As Integer, w As Integer
    Dim oPP As PowerPoint.Application, oSlide As PowerPoint.Slide, oShape As PowerPoint.Shape
    Dim wb As Workbook
    
    On Error Resume Next
    With Application
        .EnableEvents = False
        .ScreenUpdating = False
        .DisplayAlerts = False
        .Calculation = xlCalculationManual
    End With
    
    Set oPP = GetObject(, "PowerPoint.Application")
    If Err.Number <> 0 Then
        MsgBox "Open your PowerPoint Presentation to COPY"
        Exit Sub
    End If

    DeleteButtons
    ActiveChart.Export ActiveWorkbook.Path & "\LoanAnalysis.gif", "GIF"
    AddButton
    
    With oPP.ActivePresentation
        n = .Slides.Count + 1
        Set oSlide = .Slides.Add(Index:=n, Layout:=ppLayoutBlank)

        With oSlide
            w = oPP.ActivePresentation.PageSetup.SlideWidth
            For i = 0 To 0
                Set oShape = .Shapes.AddPicture( _
                        Filename:=ActiveWorkbook.Path & "\LoanAnalysis.gif", _
                        LinkToFile:=msoFalse, _
                        SaveWithDocument:=msoTrue, _
                        Left:=2, _
                        Top:=137, _
                        Width:=716, _
                        Height:=500)
                With oShape
                    .Width = w - 72
                    .Left = (w - .Width) / 2
'                    .Top = oPP.ActivePresentation.PageSetup.SlideHeight - (.Height - 36) * i
                    .Top = 36 + .Height * i
                End With
            Next
        End With
    End With
    
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
        .DisplayAlerts = True
        .Calculation = xlCalculationAutomatic
    End With
    
    Set oSlide = Nothing
    Set oPP = Nothing
End Sub
Sub AddButton()
    Dim oBTN As Object, sName As String
    sName = "COPY"
    With ActiveChart
        Set oBTN = .Buttons.Add(0, 0, 50, 20)
        With oBTN
            .OnAction = ActiveChart.CodeName & ".CopyCharts"
            .Name = "btn" & sName
            .Caption = sName
        End With
    End With
        Set oBTN = Nothing
End Sub
Sub DeleteButtons()
    Dim shp As Shape
    For Each shp In ActiveChart.Shapes
        With shp
            Select Case .Type
                Case msoChart
                Case msoFormControl: .Delete
            End Select
        End With
    Next
End Sub

Skip,

_{[red]Be Advised![/red] A chicken, who would drag a wagon across the road for 2 cents, is…
POULTRY in motion to PULLET for a PALTRY amount!}