Note: The other languages of the website are Google-translated. Back to English

Cum se exportă diagrame simple sau toate din foile de lucru Excel în PowerPoint?

Uneori, poate fi necesar să exportați o diagramă sau toate diagramele din Excel în PowerPoint pentru un anumit scop. Acest articol vorbește despre cum să-l realizăm.

Exportați o singură diagramă sau toate graficele din foaia de lucru Excel în PowerPoint cu cod VBA


Exportați o singură diagramă sau toate graficele din foaia de lucru Excel în PowerPoint cu cod VBA

Această secțiune va introduce coduri VBA pentru a exporta o singură diagramă sau toate diagramele din registrul de lucru în PowerPoint. Vă rugăm să faceți următoarele.

1. apasă pe Alt + F11 tastele împreună pentru a deschide fișierul Microsoft Visual Basic pentru aplicații fereastră.

2. În Microsoft Visual Basic pentru aplicații fereastră, faceți clic pe unelte > Referinte după cum se arată în imaginea de mai jos.

3. În Referințe - VBAProject caseta de dialog, derulați în jos pentru a găsi și verificați Biblioteca de obiecte Microsoft PowerPoint , apoi faceți clic pe OK buton. Vedeți captura de ecran:

4. Apoi apasa Insera > Module.

5. Dacă doriți să exportați un singur grafic în PowerPoint, vă rugăm să mergeți pentru a selecta graficul din foaia de lucru, apoi reveniți la Microsoft Visual Basic pentru aplicații fereastra, copiați și lipiți codul VBA de mai jos în fereastra Module.

Cod VBA: exportați o singură diagramă din foaia de lucru Excel în PowerPoint

Sub SingleActiveChartToPowerPoint_EarlyBinding1()
'Updated by Extendoffice 2017/9/15
  Dim pptApp As PowerPoint.Application
  Dim pptPres As PowerPoint.Presentation
  Dim pptSlide As PowerPoint.Slide
  Dim pptShape As PowerPoint.Shape
  Dim pptShpRng As PowerPoint.ShapeRange
  Dim xActiveSlideNow As Long
  On Error Resume Next
  If ActiveChart Is Nothing Then
    MsgBox "Select a chart and try again!", vbExclamation, "KuTools For Excel"
    Exit Sub
  End If
  Set pptApp = GetObject(, "PowerPoint.Application")
  If pptApp Is Nothing Then
    Set pptApp = CreateObject("PowerPoint.Application")
    Set pptPres = pptApp.Presentations.Add
    Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
  Else
    If pptApp.Presentations.Count > 0 Then
      Set pptPres = pptApp.ActivePresentation
      If pptPres.Slides.Count > 0 Then
        xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
        Set pptSlide = pptPres.Slides(xActiveSlideNow)
      Else
        Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
      End If
    Else
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    End If
  End If
  ActiveChart.ChartArea.Copy
  With pptSlide
    .Shapes.Paste
    Set pptShape = .Shapes(.Shapes.Count)
    Set pptShpRng = .Shapes.Range(pptShape.Name)
  End With
  With pptShpRng
    .Align msoAlignCenters, True
    .Align msoAlignMiddles, True
  End With
  pptShpRng.Select
End Sub

Dacă doriți să exportați toate diagramele din registrul de lucru, vă rugăm să copiați și să lipiți codul VBA de mai jos în fereastra Module.

Cod VBA: exportați toate diagramele din foile de lucru Excel în PowerPoint

Option Explicit
'Updated by Extendoffice 2017/9/15
Dim pptApp As PowerPoint.Application
Dim pptPres As PowerPoint.Presentation
Dim pptSlide As PowerPoint.Slide
Dim pptSlideCount As Integer
Sub ChartsToPowerPoint()
    Dim xSheet As Worksheet
    Dim xChartsCount As Integer
    Dim xChart As Object
    Dim xActiveSlideNow As Integer
    On Error Resume Next
    For Each xSheet In ActiveWorkbook.Worksheets
        xChartsCount = xChartsCount + xSheet.ChartObjects.Count
    Next xSheet
    If xChartsCount = 0 Then
        MsgBox "Sorry, there are no charts to export!", vbCritical, "Ops"
        Exit Sub
    End If
    Set pptApp = GetObject(, "PowerPoint.Application")
    If pptApp Is Nothing Then
      Set pptApp = CreateObject("PowerPoint.Application")
      Set pptPres = pptApp.Presentations.Add
      Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
    Else
        If pptApp.Presentations.Count > 0 Then
          Set pptPres = pptApp.ActivePresentation
          If pptPres.Slides.Count > 0 Then
            xActiveSlideNow = pptApp.ActiveWindow.View.Slide.SlideIndex
            Set pptSlide = pptPres.Slides(xActiveSlideNow)
          Else
            Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
          End If
        Else
          Set pptPres = pptApp.Presentations.Add
          Set pptSlide = pptPres.Slides.Add(1, ppLayoutBlank)
        End If
    End If
    For Each xSheet In ActiveWorkbook.Worksheets
        For Each xChart In xSheet.ChartObjects
            Call pptFormat(xChart.Chart)
        Next xChart
    Next xSheet
    For Each xChart In ActiveWorkbook.Charts
        Call pptFormat(xChart)
    Next xChart
    
    Set pptSlide = Nothing
    Set pptPres = Nothing
    Set pptApp = Nothing
    MsgBox "The charts were copied successfully to the new presentation!", vbInformation, "KuTools For Excel"
End Sub
Private Sub pptFormat(xChart As Chart)
    Dim xCharTiTle As String
    Dim I As Integer
    On Error Resume Next
    xCharTiTle = xChart.ChartTitle.Text
    xChart.ChartArea.Copy
    pptSlideCount = pptPres.Slides.Count
    Set pptSlide = pptPres.Slides.Add(pptSlideCount + 1, ppLayoutBlank)
    pptSlide.Select
    pptSlide.Shapes.PasteSpecial ppPasteJPG
    If xCharTiTle <> "" Then
        pptSlide.Shapes.AddTextbox msoTextOrientationHorizontal, 12.5, 20, 694.75, 55.25
    End If
    For I = 1 To pptSlide.Shapes.Count
        With pptSlide.Shapes(I)
            Select Case .Type
                Case msoPicture:
                    .Top = 87.84976
                    .left = 33.98417
                    .Height = 422.7964
                    .Width = 646.5262
                Case msoTextBox:
                    With .TextFrame.TextRange
                        .ParagraphFormat.Alignment = ppAlignCenter
                        .Text = xCharTiTle
                        .Font.Name = "Tahoma (Headings)"
                        .Font.Size = 28
                        .Font.Bold = msoTrue
                    End With
                End Select
        End With
    Next I
End Sub

6. apasă pe F5 sau faceți clic pe butonul Executare pentru a rula codul. Apoi, un nou PowerPoint va fi deschis cu graficul selectat sau cu toate graficele importate. Și vei primi un Kutools pentru Excel caseta de dialog, așa cum este prezentată mai jos, faceți clic pe OK butonul.


Legate de articole:


Cele mai bune instrumente de productivitate Office

Kutools pentru Excel vă rezolvă majoritatea problemelor și vă crește productivitatea cu 80%

  • reutilizarea: Introduceți rapid formule complexe, diagrame și orice ai folosit anterior; Criptați celulele cu parola; Creați o listă de corespondență și trimiteți e-mailuri ...
  • Super Formula Bar (editați cu ușurință mai multe linii de text și formulă); Layout de citire (citiți și editați cu ușurință un număr mare de celule); Lipiți la interval filtrat...
  • Merge celule / rânduri / coloane fără a pierde date; Conținut de celule divizate; Combinați rânduri / coloane duplicate... Prevenirea celulelor duplicate; Comparați gamele...
  • Selectați Duplicat sau Unic Rânduri; Selectați Rânduri goale (toate celulele sunt goale); Super Find și Fuzzy Find în multe cărți de lucru; Selectare aleatorie ...
  • Copie exactă Mai multe celule fără modificarea referinței formulelor; Creați automat referințe la foi multiple; Introduceți gloanțe, Casete de selectare și multe altele ...
  • Extrageți textul, Adăugați text, eliminați după poziție, Eliminați spațiul; Creați și imprimați subtotaluri de paginare; Convertiți conținutul dintre celule și comentarii...
  • Super Filtru (salvați și aplicați scheme de filtrare altor foi); Sortare avansată după lună / săptămână / zi, frecvență și multe altele; Filtru special cu bold, italic ...
  • Combinați cărți de lucru și foi de lucru; Merge Tables pe baza coloanelor cheie; Împărțiți datele în mai multe foi; Conversia în loturi xls, xlsx și PDF...
  • Peste 300 de funcții puternice. Suportă Office / Excel 2007-2021 și 365. Acceptă toate limbile. Implementare ușoară în întreprinderea sau organizația dvs. Funcții complete Probă gratuită de 30 de zile. Garanție de returnare a banilor de 60 de zile.
fila kte 201905

Fila Office aduce interfața cu file în Office și vă face munca mult mai ușoară

  • Activați editarea și citirea cu file în Word, Excel, PowerPoint, Publisher, Access, Visio și Project.
  • Deschideți și creați mai multe documente în filele noi ale aceleiași ferestre, mai degrabă decât în ​​ferestrele noi.
  • Vă crește productivitatea cu 50% și reduce sute de clicuri de mouse pentru dvs. în fiecare zi!
fundul officetab
Comentarii (7)
Încă nu există evaluări. Fii primul care evaluează!
Acest comentariu a fost redus la minimum de moderatorul de pe site
Mulțumesc, codul tău a funcționat perfect pentru ceea ce trebuia să fac. Îți voi marca pagina și revin când am nevoie de mai multe.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, mulțumesc pentru cod.

Am încercat să-ți actualizez codul cu mici modificări, dar nu știu cum pot să o fac, am nevoie să actualizez/modific unele forme pe un anumit slide, dar nu știu cum pot să o fac.?
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut Antoni,
Îmi pare rău că nu te pot ajuta încă cu asta. Multumesc pentru comentariul tau.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Salut,
Cum pot avea unele lucruri în PDF?

Mulțumesc !
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună,

Am încercat să rulez codul dvs., dar deși îmi trimite acest mesaj, nu deschide niciun powerpoint, fără să arunce vreo eroare.
Diagramele trebuie să fie într-o foaie unică sau nu există nicio problemă dacă sunt într-o foaie toate împreună?

Multumesc.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună Andreas,
Puteți exporta o singură diagramă selectând-o și rulând primul cod.
Sau exportați toate diagramele din registrul de lucru cu al doilea cod.
Multumesc pentru comentariu.
Acest comentariu a fost redus la minimum de moderatorul de pe site
Bună, codul tău este foarte asemănător cu cel pe care l-am făcut, dar am o întrebare, cum pot lipi grafica, dar pot edita datele în fișierul power point?
Nu există comentarii postate aici încă
Lăsa comentarii
Postare ca invitat
×
Evaluează această postare:
0   Caractere
Locații sugerate

Urmărește-ne

Copyright © 2009 - www.extendoffice.com. | Toate drepturile rezervate. Cu sprijinul ExtendOffice. | Harta site-ului
Microsoft și sigla Office sunt mărci comerciale sau mărci comerciale înregistrate ale Microsoft Corporation în Statele Unite și / sau în alte țări.
Protejat de Sectigo SSL