Hvordan eksporteres enkelt- eller alle diagrammer fra Excel-regneark til PowerPoint?
Nogle gange kan det være nødvendigt at eksportere et diagram eller alle diagrammer fra Excel til PowerPoint til et eller andet formål. Denne artikel taler om, hvordan man opnår det.
Eksporter enkelt diagram eller alle diagrammer fra Excel-regneark til PowerPoint med VBA-kode
Eksporter enkelt diagram eller alle diagrammer fra Excel-regneark til PowerPoint med VBA-kode
Dette afsnit introducerer VBA-koder til at eksportere et enkelt diagram eller alle diagrammer fra projektmappe til PowerPoint. Gør som følger.
1. Tryk på andre + F11 nøgler sammen for at åbne Microsoft Visual Basic til applikationer vindue.
2. i Microsoft Visual Basic til applikationer vindue, skal du klikke på Værktøjer > Referencer som vist nedenstående skærmbillede.
3. i Referencer - VBAProject dialogboksen, rul ned for at finde og kontrollere Microsoft PowerPoint-objektbibliotek og klik derefter på OK knap. Se skærmbillede:
4. Klik derefter på indsatte > Moduler.
5. Hvis du vil eksportere et enkelt diagram til PowerPoint, skal du gå til at vælge diagrammet i regnearket og derefter vende tilbage til Microsoft Visual Basic til applikationer vindue, kopier og indsæt nedenstående VBA-kode i modulvinduet.
VBA-kode: Eksporter enkelt diagram fra Excel-regneark til 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 SubHvis du vil eksportere alle diagrammer fra projektmappen, skal du kopiere og indsætte nedenstående VBA-kode i modulvinduet.
VBA-kode: Eksportér alle diagrammer fra Excel-regneark til 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 Sub6. Tryk på F5 eller klik på knappen Kør for at køre koden. Derefter åbnes en ny PowerPoint med det valgte diagram eller alle importerede diagrammer. Og du får en Kutools til Excel dialogboks som vist nedenstående skærmbillede, skal du klikke på OK .
Relaterede artikler:
- Hvordan gemmes, eksporteres flere / alle ark for at adskille csv- eller tekstfiler i Excel?
- Hvordan gemmes markering eller hele projektmappen som PDF i Excel?
Bedste kontorproduktivitetsværktøjer
Overlad dine Excel-færdigheder med Kutools til Excel, og oplev effektivitet som aldrig før. Kutools til Excel tilbyder over 300 avancerede funktioner for at øge produktiviteten og spare tid. Klik her for at få den funktion, du har mest brug for...
Fanen Office bringer en grænseflade til et kontor med Office, og gør dit arbejde meget lettere
- Aktiver redigering og læsning af faner i Word, Excel, PowerPoint, Publisher, Access, Visio og Project.
- Åbn og opret flere dokumenter i nye faner i det samme vindue snarere end i nye vinduer.
- Øger din produktivitet med 50 % og reducerer hundredvis af museklik for dig hver dag!
