Wie Sie Bilder aus Excel in PowerPoint VBA einfügen, ohne die Methode .Select zu verwenden

-1

Ich schreibe einen Code, der eine PowerPoint-Datei aus Excel VBA erstellt, mit Daten aus dem Excel-Dokument. In diesem Dokument habe ich ein Blatt namens IMG, wo es eine Reihe von Bildern mit dem Namen "Bild X" gibt, wobei X die Nummer des aktuellen Bildes ist. Der Code, den ich habe, um diese Bilder zu kopieren und sie in ihre jeweilige PowerPoint-Folie einzufügen, verwendet die .Select-Methode, die, wie ich hier gelesen habe, den Code langsamer laufen lässt und vermeidbar sein kann/muss. Ich möchte wissen, ob es möglich ist, die ".Select" -Methode zu vermeiden und dennoch die Bilder aus dem Excel-Blatt einfügen zu können.Wie Sie Bilder aus Excel in PowerPoint VBA einfügen, ohne die Methode .Select zu verwenden

Der Code Ich verwende ist:

Dim pptSlide As PowerPoint.Slide 

Sheets("IMG").Select 
    ActiveSheet.Shapes.Range(Array("Picture 1")).Select 
    Selection.Copy 

pptSlide.Shapes.PasteSpecial(ppPasteMetafilePicture).Select 
pptSlide.Shapes(4).Width = 121 
pptSlide.Shapes(4).Height = 51 
pptSlide.Shapes(4).Left = 580 
pptSlide.Shapes(4).Top = 3

Dank

Rest meines Code:

Dim pptApp As PowerPoint.Application 
Dim pptPres As PowerPoint.Presentation 
Dim pptSlide As PowerPoint.Slide 
Dim pptShape As PowerPoint.Shape 
Dim excelTable As Excel.Range 
Dim SlideTitle As String 
Dim SlideText As String 
Dim SlideObject As Object 
Dim pptTextbox As PowerPoint.Shape 
Dim SlideNumber As String 
Dim myPic As Object 



On Error Resume Next 
Set pptApp = New PowerPoint.Application 


Set pptPres = pptApp.Presentations.Add 
pptPres.PageSetup.SlideSize = ppSlideSizeOnScreen 
pptPres.ApplyTemplate "c:\Program Files\Microsoft Office\Templates\1033\Blank.potx" 

pptPres.PageSetup.FirstSlideNumber = 0 

''Consolidados 
Set excelTable1 = Worksheets("TDCSD").Range("N280:U287") 
Set excelTable2 = Worksheets("TDEXITO").Range("N48:U55") 
Set excelTable3 = Worksheets("TDGPA").Range("N81:U88") 
Set excelTable4 = Worksheets("TDSACI").Range("N234:U241") 
Set excelTable5 = Worksheets("TDSMU").Range("N47:U54") 
Set excelTable6 = Worksheets("TDRPLY").Range("N76:U83") 
Set excelTable7 = Worksheets("TDInR").Range("N44:U51") 
Set excelTable8 = Worksheets("TDPA").Range("N59:U66") 
Set excelTable9 = Worksheets("TDIRSA").Range("N31:U38") 
Set excelTable10 = Worksheets("TCOM").Range("Q8:AC17") 
Set excelTable11 = Worksheets("TCOM").Range("Q24:AC33") 


'SLIDES 

'Slide 0 

Set pptSlide = pptPres.Slides.Add(1, ppLayoutTitle) 

SlideTitle = ThisWorkbook.Sheets("PPT").Range("F7").Value 
pptSlide.Shapes(1).TextFrame.TextRange.Text = SlideTitle 

pptSlide.Shapes.Title.TextFrame.TextRange.Characters(Start:=36, Length:=65).Font.Size = 20 
pptSlide.Shapes.Title.Width = 610 

pptSlide.Shapes(2).TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B7").Value 

'Agregar el número de diapositiva en la esquina derecha: 
Set pptTextbox = pptSlide.Shapes.AddTextbox(_ 
    msoTextOrientationHorizontal, 686, 510, 34, 29) 

With pptTextbox.TextFrame 
    .TextRange.InsertSlideNumber 
    .TextRange.Font.Size = 8 
    .TextRange.Font.Name = "Tahoma" 
    .TextRange.Font.Color = RGB(137, 137, 137) 
    .VerticalAnchor = msoAnchorMiddle 
End With 



'Slide 1: 

Set pptSlide = pptPres.Slides.Add(2, ppLayoutCustom) 
SlideTitle = "Introducción" 
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle 
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22 


Set pptTextbox = pptSlide.Shapes(1) 

pptTextbox.TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B11").Value 
pptTextbox.Top = 88 
pptTextbox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignJustify 

'Agregar el número de diapositiva: 
Set pptTextbox = pptSlide.Shapes.AddTextbox(_ 
    msoTextOrientationHorizontal, 686, 510, 34, 29) 

With pptTextbox.TextFrame 
    .TextRange.InsertSlideNumber 
    .TextRange.Font.Size = 8 
    .TextRange.Font.Name = "Tahoma" 
    .TextRange.Font.Color = RGB(137, 137, 137) 
    .VerticalAnchor = msoAnchorMiddle 
End With 




'Slide 2: 
Set pptSlide = pptPres.Slides.Add(3, ppLayoutTitleOnly) 
SlideTitle = "Agenda" 
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle 
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22 

Set pptTextbox = pptSlide.Shapes.AddTextbox(_ 
    msoTextOrientationHorizontal, 686, 510, 34, 29) 

With pptTextbox.TextFrame 
    .TextRange.InsertSlideNumber 
    .TextRange.Font.Size = 8 
    .TextRange.Font.Name = "Tahoma" 
    .TextRange.Font.Color = RGB(137, 137, 137) 
    .VerticalAnchor = msoAnchorMiddle 
End With 


'Slide 3: 
''Crear Slide y añadir título 
Set pptSlide = pptPres.Slides.Add(4, ppLayoutCustom) 
SlideTitle = "Noticias Relevantes" 
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle 
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22 

''Insertar el texto desde Excel 
Set pptTextbox = pptSlide.Shapes(1) 

pptTextbox.TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B24").Value 
pptTextbox.Top = 68.8 
pptTextbox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignJustify 

''Añadir número de Slide 
Set pptTextbox = pptSlide.Shapes.AddTextbox(_ 
    msoTextOrientationHorizontal, 686, 510, 34, 29) 

With pptTextbox.TextFrame 
    .TextRange.InsertSlideNumber 
    .TextRange.Font.Size = 8 
    .TextRange.Font.Name = "Tahoma" 
    .TextRange.Font.Color = RGB(137, 137, 137) 
    .VerticalAnchor = msoAnchorMiddle 
End With 

'Añadir imagenes 
'Falabella 
Sheets("IMG").Shapes("Picture 1").Copy 
pptSlide.Shapes.PasteSpecial(ppPasteMetafilePicture).Select 
pptSlide.Shapes(4).Width = 121 
pptSlide.Shapes(4).Height = 51 
pptSlide.Shapes(4).Left = 579.4 
pptSlide.Shapes(4).Top = 3.4 


'Slide 4: 
''Crear Slide y añadir el título 
Set pptSlide = pptPres.Slides.Add(5, ppLayoutCustom) 
SlideTitle = "Noticias Relevantes" 
pptSlide.Shapes.Title.TextFrame.TextRange.Text = SlideTitle 
pptSlide.Shapes.Title.TextFrame.TextRange.Font.Size = 22 

''Añadir texto 
Set pptTextbox = pptSlide.Shapes(1) 

pptTextbox.TextFrame.TextRange.Text = ThisWorkbook.Sheets("PPT").Range("B49").Value 
pptTextbox.Top = 77 
pptTextbox.TextFrame.TextRange.Paragraphs.ParagraphFormat.Alignment = ppAlignJustify 

''Añadir número de Slide 
Set pptTextbox = pptSlide.Shapes.AddTextbox(_ 
    msoTextOrientationHorizontal, 686, 510, 34, 29) 

With pptTextbox.TextFrame 
    .TextRange.InsertSlideNumber 
    .TextRange.Font.Size = 8 
    .TextRange.Font.Name = "Tahoma" 
    .TextRange.Font.Color = RGB(137, 137, 137) 
    .VerticalAnchor = msoAnchorMiddle 
End With 

''Añadir imagenes 
'Grupo Éxito 
Sheets("IMG").Shapes("Picture 2").Copy 

pptSlide.Shapes.PasteSpecial (ppPasteMetafilePicture) 
pptSlide.Shapes(4).Width = 108 
pptSlide.Shapes(4).Height = 65 
pptSlide.Shapes(4).Left = 592 
pptSlide.Shapes(4).Top = 1.42

Quelle

2017-02-01 thePB

Guter Ruf auf die Vermeidung von "Auswählen" das Objekt. Die einzige Zeit, die ich wirklich auswählen kann, ist, wenn ich den Benutzer absichtlich auf einen Tab/eine Zelle lenke.

So wie etwa diese:

Dim s As Shape 
Dim ws As Worksheet 

Set ws = ThisWorkbook.Worksheets("IMG") 
Set s = ws.Shapes("Picture 1") 

s.Copy

Und natürlich könnte man Schleife durch jede Form auf dem Arbeitsblatt:

for each s in ws.shapes 
    debug.print s.name 
    s.copy 
    'Code for pasting the image 
next s

Viel Glück! Ich hoffe es hilft!

Quelle

2017-02-02 04:07:36 Benjamin

Verwenden Sie den nachstehenden Code, um ein Bild aus dem Excel-Arbeitsblatt (ohne Select) zu kopieren und in eine PowerPoint-Folie einzufügen.

Hinweis: Ich nehme an, das Teil, das Sie Ihre Powerpoint-Präsentation und Einstellung pptSlide Arbeiten für Sie, und das einzige, was links ist Kopieren >> Einfügen das Bild Set-up.

-Code

Option Explicit 

Sub CopyPic_to_PPT() 

Dim pptSlide As PowerPoint.Slide 
Dim myPic As Object              

Sheets("IMG").Shapes("Picture 1").Copy '<-- copy the "Picture 1" image from "IMG" worksheet 

' set myPic to current pasted shape in PowerPoint 
Set myPic = pptSlide.Shapes.PasteSpecial(ppPasteMetafilePicture, msoFalse) 

' modify current pic setting 
With myPic 
    .Width = 121 
    .Height = 51 
    .Left = 580 
    .Top = 3 
End With 

End Sub

Extra- (der sicherere Modus): Wenn Sie durch all Shapes in "IMG" Arbeitsblatt Schleife mögen, die Namen der einzelnen Form überprüfen, ob es "Bild 1" ist, und nur Kopieren Sie dann diese Form in die PowerPoint-Folie, und verwenden Sie dann auch das folgende Codeelement:

Quelle

2017-02-02 06:19:33

Vielen Dank. Es war hilfreich. Aber das Einzige ist, dass die Positionierung nicht mit der "With" -Funktion funktioniert. weiß nicht, warum – thePB

Sie meinen gesamten Code kopiert und die Positionierung funktioniert nicht? erhalten Sie einen Fehler? oder es wird nicht neu positioniert? –

Nein, ich habe Ihren Code für die Bilder meines Codes kopiert (was ein langer Code ist und andere Dinge hat, die dies beeinflussen könnten). Es gab mir keinen Fehler, aber als ich das PPT öffnete, war das Bild nicht positioniert – thePB

Wie Sie Bilder aus Excel in PowerPoint VBA einfügen, ohne die Methode .Select zu verwenden

Antwort

Verwandte Themen