Live-Forum - Die aktuellen Beiträge
Datum
Titel
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1756to1760
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Zell-Berich in PPT übertragen

Zell-Berich in PPT übertragen
14.05.2020 09:43:09
lemmy
Hallo zusammen,
leider bin ich kein VB Progammmierer !
Ich möchte einen Bereich A10-E20 Kopieren und als Bild immer auf der 5 Seite (ohne Abfrage der Seite in PPT) absetzen. (Ausführung A)
Ich möchte einen Bereich A10-E20 Kopieren und als Bild immer auf der 5 Seite (---mit----Abfrage der Seite in PPT) absetzen. (Ausführung B)
Das Bild soll immer von rechts 10 und von oben 15 cm in die PPT eingesetz werden.
...ich habe zwar ein Makro gefunden welches ich leider nicht anpassen kann.

Sub TabelleZuPowerPoint()
' Verweis auf Microsoft PowerPoint 14.0 Object Library
Dim Pp As PowerPoint.Application
Dim Praes As PowerPoint.Presentation
Dim Folie As PowerPoint.Slide
Dim ppTab As PowerPoint.Shape
Worksheets(10).Range("A15:E25").Copy
Set Pp = CreateObject("Powerpoint.Application")
Pp.Visible = True
Set Praes = Pp.Presentations.Add
Pp.ActiveWindow.ViewType = ppViewSlide
Set Folie = Praes.Slides.Add(1, ppLayoutTitleOnly)
Folie.Shapes.PasteSpecial DataType:=ppPasteEnhancedMetafile
Set ppTab = Folie.Shapes(Folie.Shapes.Count)
ppTab.Left = 234
ppTab.Top = 186
''PowerPoint-Präsentation speichern und schließen
'With Praes
'    .SaveAs '"C:\My Documents\MyPreso.ppt"
'    .Close
'End With
''PowerPoint beenden
'Pp.Quit
'Variablen rücksetzen
Set Folie = Nothing
Set Praes = Nothing
Set Pp = Nothing
End Sub

11
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Zell-Berich in PPT übertragen
14.05.2020 09:49:25
lemmy
...das Bild soll immer in die zuletzt geöffnete Datei (PPT) übertragen werden.
LG
Lemmy
AW: Zell-Berich in PPT übertragen
14.05.2020 13:37:50
volti
Hallo Lemmy,
hier mal ein Ansatz zur Lösung Deines Projektes.
Ich denke, Dein gefundener Code ist zu weit von Deiner Anforderung entfernt. Es wird dort u.a. immer eine neue Präsentation aufgemacht, da wird es keine Folie 5 geben...
Ich habe deshalb einen neuen code aufgesetzt. Dieser benötigt auch keinen Verweis auf PowerPoint.
Es wird die gerade geöffnete Präsentation verwendet oder, wenn aktuell keine geöffnet ist, die angegebene Datei geöffnet und in Folie 5 an der von Dir noch anzupassenden Position das Bild mit der von Dir angegebenen Größe reinkopiert.
Das neue Bild bekommt einen Namen, so dass es bei erneutem Kopieren entfernt und wieder wieder reingesetzt (überschrieben) wird.
Die Positionierung erfolgt in Pixel. cm-Angaben kann ich grad nicht.
PS: Dies ist ein schon etwas anspruchsvollerer code, da es sehr viele Möglichkeiten allein schon beim Kopieren und Einfügen gibt. Was nun am besten aussieht, müsste getestet werden.
Auch Deine Anmerkung zu Ausführung B ist mir unverständlich. Wieso eine Seitenabfrage, wenn sowieso immer Folie 5 genommen wird?
Teste einfach mal, ob das so hinkommen kann:
Code in die Zwischenablage
Option Explicit
Sub BereichNachPPt()
'SUb kopiert in eine geöffnete Präsentation einen kopierten Bereich als Bild
'oder öffnet die angegebene Datei auf der Festplatte
 Dim pptObjekt As Object, pptApp As Object
 Dim pptFolie As Object, pptPres As Object
 Dim sFile As String, sPicName As String
 Dim Br, Ho
'Pfad und Dateiname (anpassen)
 sFile = "D:\Twelt\TEXd\TEX.pptm"
'Name des kopierten Bereichs bei Bedarf anpassen
 sPicName = "MyPic"
 On Error Resume Next
'Bereich kopieren, Blatt und Range ggf. anpassen
 With ThisWorkbook.Sheets("Tabelle2").Range("$A10:$E20")
  .CopyPicture Appearance:=xlScreen, Format:=xlBitmap   'xlPicture
 End With
'PPt holen oder Neu aufmachen
 Set pptApp = GetObject(, "PowerPoint.Application") 'geöffnete PPt ansprechen
 If pptApp Is Nothing Then
    Set pptApp = CreateObject("PowerPoint.Application")
 End If
 If Not pptApp Is Nothing Then                  'PPt Anwendung gefunden
   pptApp.Visible = True
   Set pptPres = ActivePresentation             'Aktuelle Präsentation nehmen
   If pptPres Is Nothing Then
    If Dir$(sFile) <> "" Then
     Set pptPres = pptApp.Presentations.Open(sFile)
    Else
     MsgBox "Habe die Datei nicht gefunden!", vbCritical, "PowerPoint"
     GoTo Ende
    End If
   End If
   If Not pptPres Is Nothing Then
    Set pptFolie = pptPres.Slides(5)            'Folie 5 nehmen anpassen
    If Not pptFolie Is Nothing Then
     pptFolie.Select
     Set pptObjekt = Nothing
     Set pptObjekt = pptFolie.Shapes(sPicName)
     If Not pptObjekt Is Nothing Then
       pptObjekt.Delete                         'Bereits vorhandenes Pic löschen
     End If
     Set pptObjekt = pptFolie.Shapes.Paste      'Bereich als Bild enfügen
     With pptObjekt                             'Objekt formatieren
      .Name = sPicName                          'Pic-Namen festlegen
      .Fill.Transparency = 0#                   'Transparent=1, sonst=0
      .LockAspectRatio = msoFalse
      .Left = 234:   .Top = 186                 'Linke obere Ecke     anpassen
      Ho = 400: Br = 400                        'Höhe, Breite absolut anpassen
      .HEIGHT = Ho: .WIDTH = Br
'Wenn Höhe, Breite <1 angegeben werden sie prozentual eingepasst
      If Ho <= 1 Then .ScaleHeight Ho, msoTrue  'Prozentuale Angabe für Höhe
      If Br <= 1 Then .ScaleWidth Br, msoTrue   'Prozentuale Angabe für Breite
      .Visible = True
     End With
     pptPres.Save                               'Präsentation speichern
     pptPres.Close                              'Präsentation schließen
    Else
     MsgBox "Habe Folie nicht gefunden!", vbCritical, "PowerPoint"
    End If
   Else
     MsgBox "Habe Präsentation nicht gefunden!", vbCritical, "PowerPoint"
   End If
Ende:
   pptApp.Quit                                  'PPt beenden
   Set pptApp = Nothing
 End If
End Sub

viele Grüße
Karl-Heinz

Anzeige
AW: Zell-Berich in PPT übertragen
14.05.2020 22:44:24
Lemmy
Hallo Karl-Heinz,
vielen Dank für deine viele Arbeit!
Ich habe nun den Code testen können. Leider schreibt er mir einen Fehler raus.
Fehlermeldung: Fehler beim Kompilieren, Variabele nicht definiert.
...das Makro hält bei ActivePresentation
If Not pptApp Is Nothing Then 'PPt Anwendung gefunden
pptApp.Visible = True
Set pptPres = ActivePresentation 'Aktuelle Präsentation nehmen
leider weis ich nun nicht weiter!
LG
Lemmy
n
AW: Zell-Berich in PPT übertragen
15.05.2020 08:54:30
volti
Hallo Lemmy,
es muss Set pptPres = pptApp.ActivePresentation heißen.
Der Befehl gehört ja zu PowerPoint und nicht zu Excel. Ich hatte das vergessen mit anzugeben.
Ich hatte das natürlich ausprobiert und bei mir kam und kommt nach wie vor keine Fehlermeldung, so dass ich es nicht bemerkt hatte.
Wenn noch was ist oder abweichende Wünsche bestehen, melde Dich hier wieder.
viele Grüße
Karl-Heinz
Anzeige
AW: Zell-Berich in PPT übertragen
17.05.2020 16:06:17
Lemmy
Hallo Karl Heinz,
alles super! funktioniert klasse!
...dürfte ich eine "kleine" Erweiterung anfragen?
Ich habe in der Zeile A10: E10 eine Auto-Filterzeile eingebracht. Nun habe ich eine Auswahl gefiltert.
Mit deinem Makro wird nun leider nur die Kopfzeile A10: E10 kopiert.
Gibt es eine Möglichkeit die nachfoldenden 5 Zeilen (sichtbare Zeilen; gefilterten Zeilen) mit in das Bild zu kopieren. Ich habe dies immer mit dem Snipping Tool von Windows durchgeführt.
Diesen Ausschnitt würde ich dann in die PPT. einbringen wollen.
Auch wenn Du nicht mehr die Zeit finden solltest, Vielen dank für deine Mühe!
LG
Lemmy
Anzeige
AW: Zell-Berich in PPT übertragen
17.05.2020 22:42:40
volti
Hallo Lemmy,
Mit deinem Makro wird nun leider nur die Kopfzeile A10: E10 kopiert.
Das kann ich erst mal nicht nachvollziehen.
Wenn ich Zeilen ausblende oder filtere, werden bei mir die sichtbaren Zeilen in das PPt-Objekt übernommen.
Ggf. müsstest Du mal Deine Mappe hier hochladen. Ansonsten kann ich nicht helfen.
VG KH
AW: Zell-Berich in PPT übertragen
18.05.2020 09:08:16
lemmy
Hallo Karl Heinz,
https:\/\/www.herber.de/bbs/user/137603.xlsm
ich habe eine Beispieldatei angefertigt. Hier habe ich in Zeile 17 die Tabellen-Kopfzeile.
Die Kopfzeile wird mit deinem Marko übertragen.
Die Filterung und damit der sichtbare Bereich Beispielhaft A15und A16 wird nicht übertragen.
..ich hatte vermutet, dass A18 und folgende Zeilen mit übertragen werden...aber diese werden auch nicht übertragen.
...wie geschrieben würde ich gerne die sichtbaren folgenden 5 Zeilen (A17,A..-A..)übertragen.
Danke für Deine Hilfe !
LG
Lemmy
Anzeige
AW: Zell-Berich in PPT übertragen
18.05.2020 15:51:24
volti
Hallo Lemmy,
Dein Ansinnen ist mir nicht ganz plausibel.
Status Quo ist, dass in Zeile 17 die nicht ausgeblendete Kopfzeile steht.
Die Zeilen 17 bis 31 sind ausgeblendet, die Zeilen 32 und 33 sind wieder eingeblendet.
Deine Vorgabe heißt With ThisWorkbook.Sheets("Daten").Range("$A17:$E20"). Es soll also von Zeile 17 bis Zeile 20 kopiert werden. In diesem Bereich ist nur die Zeile 17 (Kopfzeile) sichtbar
In soweit alles plausibel.
Wenn Du die Zeilen 32, 33 mit übertragen möchtest, musst Du auch Deinen Bereich anpassen:
With ThisWorkbook.Sheets("Daten").Range("$A17:$E35")
Möchtest Du ab Zeile 17 dynamisch alle benutzten und nicht ausgeblendeten Zeilen in Deine Übertragung einbeziehen, kannst Du es auch so machen:
'Bereich kopieren, Blatt und Range ggf. anpassen
 With ThisWorkbook.Sheets("Daten")
  With .Range("$A17:$E" & .Cells(Rows.Count, "A").End(xlUp).Row)
    .CopyPicture Appearance:=xlScreen, Format:=xlBitmap   'xlPicture
  End With
 End With

viele Grüße
Karl-Heinz
Anzeige
AW: Zell-Berich in PPT übertragen
19.05.2020 07:45:59
lemmy
Hallo Karl-Heinz,
"dynamisch" ist die richtige Bezeichnung meines Anliegens!
...habe dies einfach nicht auf den Punkt gebracht.
Zeile 17 soll immer im Bildausschnitt sein.
Das Beispiel hat leider nur 2 sichbaren Zeilen ausgeführt (32,33).
In der Regel habe ich aber deutlich mehr als 5 Zeilen sichbar.
Ich würde eben dynamisch bis zu 5 Zeilen in die Kopie übertragen wollen.
Zeile 17 plus bis zu 5 dynamisch Zeilen
Sind nur 2 Zeilen ab Zeile 18 gefüllt so sollen nur 2 Zeilen übertragen werden.
Sind mehr als 5 Zeilen vorhanden, so sollen max 5 Zeilen übertragen werden.
Info ...sollte es relevant sein:
Das Ende der Tabelle kann schon mal Zeile größer 5000 überschreiten.
...ich hoffe Karl Heinz dass dies noch o.k. ist.
Vielen Dank, Du hast mir schon sehr weitergeholfen.:)
LG
Lemmy
Anzeige
AW: Zell-Berich in PPT übertragen
19.05.2020 10:30:08
volti
Hallo Lemmy,
teste mal das anliegende Makro. Es werden jetzt maximal 5 sichtbare Zeilen in PPt übernommen.
Code in die Zwischenablage
Option Explicit
Sub BereichNachPPt()
'SUb kopiert in eine geöffnete Präsentation einen kopierten Bereich als Bild
'oder öffnet die angegebene Datei auf der Festplatte
 Dim pptObjekt As Object, pptApp As Object
 Dim pptFolie As Object, pptPres As Object
 Dim sFile As String, sPicName As String, sBer As String
 Dim Br, Ho, iZeile As Integer, ZlEnd As Long
'Pfad und Dateiname (anpassen)
 sFile = "D:\Twelt\TEXd\TEX.pptm"
'Name des kopierten Bereichs bei Bedarf anpassen
 sPicName = "MyPic"
 On Error Resume Next
'Bereich kopieren, Blatt und Range ggf. anpassen
 With ThisWorkbook.Sheets("Daten")
  sBer = "$A17"                                     'Hier BeginnZeile angeben
  For iZeile = Range(sBer).Row + 1 To .Cells(Rows.Count, "A").End(xlUp).Row
   If .Cells(iZeile, "A").EntireRow.Hidden = False Then
      ZlEnd = ZlEnd + 1: If ZlEnd > 5 Then Exit For
   End If
  Next iZeile
  sBer = sBer & ":$A$" & (iZeile - 1)
  .Range(sBer).CopyPicture Appearance:=xlScreen, Format:=xlBitmap   'xlPicture
 End With
'PPt holen oder Neu aufmachen
 Set pptApp = GetObject(, "PowerPoint.Application") 'geöffnete PPt ansprechen
 If pptApp Is Nothing Then
    Set pptApp = CreateObject("PowerPoint.Application")
 End If
 If Not pptApp Is Nothing Then                  'PPt Anwendung gefunden
   pptApp.Visible = True
   Set pptPres = pptApp.ActivePresentation      'Aktuelle Präsentation nehmen
   If pptPres Is Nothing Then
    If Dir$(sFile) <> "" Then
     Set pptPres = pptApp.Presentations.Open(sFile)
    Else
     MsgBox "Habe die Datei nicht gefunden!", vbCritical, "PowerPoint"
     GoTo Ende
    End If
   End If
   If Not pptPres Is Nothing Then
    Set pptFolie = pptPres.Slides(5)            'Folie 5 nehmen anpassen
    If Not pptFolie Is Nothing Then
     pptFolie.Select
     Set pptObjekt = Nothing
     Set pptObjekt = pptFolie.Shapes(sPicName)
     If Not pptObjekt Is Nothing Then
       pptObjekt.Delete                         'Bereits vorhandenes Pic löschen
     End If
     Set pptObjekt = pptFolie.Shapes.Paste      'Bereich als Bild enfügen
     With pptObjekt                             'Objekt formatieren
      .Name = sPicName                          'Pic-Namen festlegen
      .Fill.Transparency = 0#                   'Transparent=1, sonst=0
      .LockAspectRatio = msoFalse
      .Left = 234:   .Top = 186                 'Linke obere Ecke     anpassen
      Ho = 50: Br = 400                         'Höhe, Breite absolut anpassen
      .Height = Ho: .Width = Br
'Wenn Höhe, Breite <1 angegeben werden sie prozentual eingepasst
      If Ho <= 1 Then .ScaleHeight Ho, msoTrue  'Prozentuale Angabe für Höhe
      If Br <= 1 Then .ScaleWidth Br, msoTrue   'Prozentuale Angabe für Breite
      .Visible = True
     End With
     'pptPres.Save                               'Präsentation speichern
     'pptPres.Close                              'Präsentation schließen
    Else
     MsgBox "Habe Folie nicht gefunden!", vbCritical, "PowerPoint"
    End If
   Else
     MsgBox "Habe Präsentation nicht gefunden!", vbCritical, "PowerPoint"
   End If
Ende:
   'pptApp.Quit                                  'PPt beenden
   Set pptApp = Nothing
 End If
End Sub

viele Grüße
Karl-Heinz

Anzeige
AW: Zell-Berich in PPT übertragen
19.05.2020 22:17:11
Lemmy
Hallo Karl Heinz,
was soll ich dazu sagen !
Alles bestens...super super gut!
Vielen Dank für deine Hilfe!
Ein schönes langes Wochenende!
LG
Lemmy

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige