Condividi:        

Copia foglio excel come immagine in slide powerpoint

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Copia foglio excel come immagine in slide powerpoint

Postdi EnricoBanco » 24/03/18 23:02

Trovato un tool sul web penso veramente utile per chi usa powerpoint
Basa inserire nome foglio (se sono da copiare più di uno), range celle da traferire e tipo di formato (qui "picture").
La macro crea il file ppt e tante slide quanti sono i fogli da copiare

http://www.filedropper.com/prova_29

Codice: Seleziona tutto
Application.DisplayAlerts = False

Sheets("Foglio1").Activate       ' <---NOME FOGLIO

 'Requires a reference to the Microsoft PowerPoint Library via the Tools - Reference menu in the VBE
    Dim ppApp As PowerPoint.Application
    Dim ppSlide As PowerPoint.Slide
     
     'Original code sourced from Jon Peltier http://peltiertech.com/Excel/XL_PPT.html
     'This code developed at http://oldlook.experts-exchange.com:8080/Applications/MS_Office/Excel/Q_21337053.html
     
    Dim SheetName As String
    Dim TestRange As Range
    Dim TestSheet As Worksheet
    Dim TestChart As ChartObject
     
    Dim PasteChart As Boolean
    Dim PasteChartLink As Boolean
    Dim ChartNumber As Long
     
    Dim PasteRange As Boolean
    Dim RangePasteType As String
    Dim RangeName As String
    Dim AddSlidesToEnd As Boolean
     
     'Parameters
     
     'SheetName           - name of sheet in Excel that contains the range or chart to copy
     
     'PasteChart          -If True then routine will  copy and paste a chart
     'PasteChartLink      -If True then Routine will paste chart with Link; if = False then paste chart no link
     'ChartNumber         -Chart Object Number
     '
     'PasteRange          - If True then Routine will copy and Paste a range
     'RangePasteType      - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values
     'RangeName           - Address or name of range to copy; "B3:G9" "MyRange"
     'AddSlidesToEnd      - If True then appednd slides to end of presentation and paste.  If False then paste on current slide.
     
     'use active sheet. This can be a direct sheet name
    SheetName = ActiveSheet.Name
     
     'Setting PasteRange to True means that Chart Option will not be used
    PasteRange = True
    RangeName = "A1:N25"          ' <---RANGE CELLE
    RangePasteType = "Picture" 
    RangeLink = True
     
    PasteChart = True
    PasteChartLink = True
    ChartNumber = 1
     
    AddSlidesToEnd = True
     
     
     'Error testing
    On Error Resume Next
    Set TestSheet = Sheets(SheetName)
    Set TestRange = Sheets(SheetName).Range(RangeName)
    Set TestChart = Sheets(SheetName).ChartObjects(ChartNumber)
    On Error GoTo 0
     
    If TestSheet Is Nothing Then
        MsgBox "Sheet " & SheetName & " does not exist. Macro will exit", vbCritical
        Exit Sub
    End If
     
    If PasteRange And TestRange Is Nothing Then
        MsgBox "Range " & RangeName & " does not exist. Macro will exit", vbCritical
        Exit Sub
    End If
     
    If PasteRange = False And PasteChart And TestChart Is Nothing Then
        MsgBox "Chart " & ChartNumber & " does not exist. Macro will exit", vbCritical
        Exit Sub
    End If
     
     
     'Look for existing instance
    On Error Resume Next
    Set ppApp = GetObject(, "PowerPoint.Application")
    On Error GoTo 0
     
     'Create new instance if no instance exists
    If ppApp Is Nothing Then Set ppApp = New PowerPoint.Application
     'Add a presentation if none exists
    If ppApp.Presentations.Count = 0 Then ppApp.Presentations.Add
     
     'Make the instance visible
    ppApp.Visible = True
     
     'Check that a slide exits, if it doesn't add 1 slide. Else use the last slide for the paste operation
    If ppApp.ActivePresentation.Slides.Count = 0 Then
        Set ppSlide = ppApp.ActivePresentation.Slides.Add(1, ppLayoutBlank)
    Else
        If AddSlidesToEnd Then
             'Appends slides to end of presentation and makes last slide active
            ppApp.ActivePresentation.Slides.Add ppApp.ActivePresentation.Slides.Count + 1, ppLayoutBlank
            ppApp.ActiveWindow.View.GotoSlide ppApp.ActivePresentation.Slides.Count
            Set ppSlide = ppApp.ActivePresentation.Slides(ppApp.ActivePresentation.Slides.Count)
        Else
             'Sets current slide to active slide
            Set ppSlide = ppApp.ActiveWindow.View.Slide
        End If
    End If
     
     'Options for Copy & Paste Ranges and Charts
    If PasteRange = True Then
         'Options for Copy & Paste Ranges
        If RangePasteType = "Picture" Then
             'Paste Range as Picture
            Worksheets(SheetName).Range(RangeName).Copy
            On Error Resume Next
            ppSlide.Shapes.PasteSpecial(ppPasteDefault, link:=RangeLink).Select
        Else
             'Paste Range as HTML
            Worksheets(SheetName).Range(RangeName).Copy
            ppSlide.Shapes.PasteSpecial(ppPasteHTML, link:=RangeLink).Select
        End If
    Else
         'Options for Copy and Paste Charts
        Worksheets(SheetName).Activate
        ActiveSheet.ChartObjects(ChartNumber).Select
        If PasteChartLink = True Then
             'Copy & Paste Chart Linked
            ActiveChart.ChartArea.Copy
            ppSlide.Shapes.PasteSpecial(link:=True).Select
        Else
             'Copy & Paste Chart Not Linked
            ActiveChart.CopyPicture Appearance:=xlScreen, Size:=xlScreen, Format:=xlPicture
            ppSlide.Shapes.Paste.Select
        End If
    End If
     
     'Center pasted object in the slide
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    ppApp.ActiveWindow.Selection.ShapeRange.Align msoAlignMiddles, True
     
    AppActivate ("Microsoft PowerPoint")
    Set ppSlide = Nothing
    Set ppApp = Nothing
     
Application.DisplayAlerts = True

End Sub


Edit
Aggiungo link Bropbox: https://www.dropbox.com/s/euwsika8tovwj ... .xlsm?dl=0
Anthony
EnricoBanco
Utente Junior
 
Post: 77
Iscritto il: 18/07/17 06:29

Sponsor
 

Re: Copia foglio excel come immagine in slide powerpoint

Postdi Anthony47 » 25/03/18 01:58

NotaBene:
Il file corrente richiede l'attivazione (tra i riferimenti vba) della Microsoft PowerPoint Object Library (perche' disegnato per lavorare in "early binding"); poiche' la mia preferenza e' lavorare in "late binding" nei prossimi giorni preparero' una versione che non richiede l'attivazione di tale libreria.

Si noti anche la presenza di numerosi parametri che definiscono origine e modalita' della copia, descritti e da impostare nel corpo della macro:
Codice: Seleziona tutto
'Parameters
     'SheetName           - name of sheet in Excel that contains the range or chart to copy
     'PasteChart          -If True then routine will  copy and paste a chart
     'PasteChartLink      -If True then Routine will paste chart with Link; if = False then paste chart no link
     'ChartNumber         -Chart Object Number
     '
     'PasteRange          - If True then Routine will copy and Paste a range
     'RangePasteType      - Paste as Picture linked or unlinked, "HTML" or "Picture". See routine below for exact values
     'RangeName           - Address or name of range to copy; "B3:G9" "MyRange"
     'AddSlidesToEnd      - If True then appednd slides to end of presentation and paste.  If False then paste on current slide.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Copia foglio excel come immagine in slide powerpoint

Postdi EnricoBanco » 29/03/18 16:15

Grazie Anthony,

scartabellando sul web ho trovato questa. La macro WorkbooktoPowerPoint_1 agisce sui fogli della cartella con range fisso

Codice: Seleziona tutto
Sub WorkbooktoPowerPoint_1()

'Mette in PowerPoint ogni foglio del file excel

'Step 1:  Declare your variables
    Dim pp As Object
    Dim PPPres As Object
    Dim ppSlide As Object
    Dim xlwksht As Worksheet
    Dim MyRange As String
    Dim MyTitle As String
   
'Step 2:  Open PowerPoint, add a new presentation and make visible
    Set pp = CreateObject("PowerPoint.Application")
    Set PPPres = pp.Presentations.Add
    pp.Visible = True
       


'Step 3:  Set the ranges for your data and title
    MyRange = "A1:M20"  '<<<Change this range
   
'Step 4:  Start the loop through each worksheet
    For Each xlwksht In ActiveWorkbook.Worksheets
    xlwksht.Select
    Application.Wait (Now + TimeValue("0:00:1"))


'Step 5:  Copy the range as picture
    xlwksht.Range(MyRange).CopyPicture _
    Appearance:=xlScreen, Format:=xlPicture   'xlBitmap
   
'Step 6:  Count slides and add new blank slide as next available slide number
          '(the number 12 represents the enumeration for a Blank Slide)
    SlideCount = PPPres.Slides.Count
    Set ppSlide = PPPres.Slides.Add(SlideCount + 1, 12)
    ppSlide.Select
         
'Step 7:  Paste the picture and adjust its position
    ppSlide.Shapes.Paste.Select
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pp.ActiveWindow.Selection.ShapeRange.Top = 1
    pp.ActiveWindow.Selection.ShapeRange.Left = 1
    pp.ActiveWindow.Selection.ShapeRange.Width = 1500
   
       
'Step 8:  Add the title to the slide then move to next worksheet
    Next xlwksht
           
'Step 9:  Memory Cleanup
    pp.Activate
    Set ppSlide = Nothing
    Set PPPres = Nothing
    Set pp = Nothing

End Sub


Mentre la macro WorkbooktoPowerPoint_2 agisce su un foglio alla volta se il range cambia in ogni foglio (apostrofato il ciclo for next)

Codice: Seleziona tutto
Sub WorkbooktoPowerPoint_2()

'Mette in PowerPoint un singolo foglio del file excel

'Step 1:  Declare your variables
    Dim pp As Object
    Dim PPPres As Object
    Dim ppSlide As Object
    Dim xlwksht As Worksheet
    Dim MyRange As String
    Dim MyTitle As String
   
'Step 2:  Open PowerPoint, add a new presentation and make visible
    Set pp = CreateObject("PowerPoint.Application")
    Set PPPres = pp.Presentations.Add
    pp.Visible = True
       
    Sheets("Foglio1").Activate

'Step 3:  Set the ranges for your data and title
    MyRange = "A1:M20"  '<<<Change this range
   
'Step 4:  Start the loop through each worksheet
   ' For Each xlwksht In ActiveWorkbook.Worksheets
   ' xlwksht.Select
   ' Application.Wait (Now + TimeValue("0:00:1"))


'Step 5:  Copy the range as picture
    Foglio1.Range(MyRange).CopyPicture _
    Appearance:=xlScreen, Format:=xlBitmap   'xlPicture
   
'Step 6:  Count slides and add new blank slide as next available slide number
          '(the number 12 represents the enumeration for a Blank Slide)
    SlideCount = PPPres.Slides.Count
    Set ppSlide = PPPres.Slides.Add(SlideCount + 1, 12)
    ppSlide.Select
         
'Step 7:  Paste the picture and adjust its position
    ppSlide.Shapes.Paste.Select
    pp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
    pp.ActiveWindow.Selection.ShapeRange.Top = 1
    pp.ActiveWindow.Selection.ShapeRange.Left = 1
    pp.ActiveWindow.Selection.ShapeRange.Width = 1500
   
       
'Step 8:  Add the title to the slide then move to next worksheet
    ' Next xlwksht
           
'Step 9:  Memory Cleanup
    pp.Activate
    Set ppSlide = Nothing
    Set PPPres = Nothing
    Set pp = Nothing
               

End Sub
EnricoBanco
Utente Junior
 
Post: 77
Iscritto il: 18/07/17 06:29

Re: Copia foglio excel come immagine in slide powerpoint

Postdi Anthony47 » 30/03/18 23:22

Grazie epr l'ulteriore condivisione.
(Naturalmente il mio messaggio precedente era diretto ad altri che avessero voluto provare quanto pubblicato, non a te che avevi gia' sperimentato prima di pubblicare)

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Copia foglio excel come immagine in slide powerpoint":


Chi c’è in linea

Visitano il forum: Nessuno e 55 ospiti