Microsoft Excel

Herbers Excel/VBA-Archiv

VBA PP auf kürzlich erstelltes Shape zugreifen

Betrifft: VBA PP auf kürzlich erstelltes Shape zugreifen von: Paddy_P
Geschrieben am: 08.10.2014 15:30:58

Hallo,

ich schreibe gerade an einem Skript bei dem ich über VBA aus Excel einen Range Kopiere und diesen in Powerpoint einfüge.

Sobald ich versuche das erstellte Shape anzusprechen (Tabelle 1) gibt es eine Fehlermeldung, dass dieses Shape nicht vorhanden wäre.

Das würde ich ja akzeptieren, aber gehe ich in den Debugmodus und drücke F8, so funktioniert es plötzlich und VBA findet das Shape.

Mein Code ist dieser:

Option Explicit

Sub Einfuegen(LC, pptPres, SS, lc, EDB)

    Dim msE As Object
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim objPPT As Object
    Dim wsh_List As Variant
    Dim i As Long
    Dim j As Long

    wsh_List = Array("Datei 1", "Datei 2", "Datei 3", "Datei 4")
    
    Set objPPT = CreateObject("Powerpoint.Application")
    Set msE = GetObject(, "Excel.Application")
    
    For Each wbk In msE.Workbooks
        For Each wsh In wbk.Worksheets
            For i = 0 To 3
                If wsh.Name = wsh_List(i) Then
                    
                    Const a = 4
                    Const b = 5
                    Const c = 4
                    Const d = 6
                    Dim Sld_list As Variant
                    Dim LC_list As Variant
                    
                    Sld_list = Array(a, b, c, d)
                    LC_list = Array("Data 1", "Data 2", "Data 3", "Data 4")
                    
                    For j = 0 To 3
                        If InStr(LC, LC_list(j)) Then
                            wsh.Range("C4:" & Chr(64 + lc) & "5").Copy
                            pptPres.Slides(Sld_list(j)).Select
                            objPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
                            With pptPres.Slides(Sld_list(j)).Shapes("Tabelle 1")
' HIER STELLT SICH VBA ETWAS QUER...
                                .Left = 20
                                .Top = 94
                                .Width = 518
                                .Height = 28
                            End With
                            
                            If InStr(LC, "Data 1") Then
                              wsh.Range(Chr(67) & SS & ":" & Chr(64 + lc) & _
                                  EDB + 1).Copy
                              objPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
                            Else
                              wsh.Range(Chr(67) & SS & ":" & Chr(64 + lc) & _
                                  EDB).Copy
                              objPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
                            End If
                            
                            With pptPres.Slides(Sld_list(j)).Shapes("Tabelle 2")
' HIER EBENFALLS DAS GLEICHE PROBLEM...
                                .Left = 20
                                .Top = 150
                                .Width = 518
                                .Height = 322
                            End With
                            Exit Function
                            
                        End If
                    Next
                End If
            Next
        Next
    Next
End Sub
Als kurze Beschreibung noch zum Skript:
Ich möchte hier mehrere Strings miteinander vergleichen und Anhand derer verschiedene Auswertungen bekommen (also mal eine andere Spalte etc.)

Ich hoffe Skript ist nicht zu verwirrend und mir kann jem. helfen...?

Danke schon mal!

  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: fcs
Geschrieben am: 08.10.2014 16:35:50

Hallo Paddy,

probiere mal folgendes:

                            With pptPres.Slides(Sld_list(j))
                              With .Shapes(.Shapes.Count)
                                  .Left = 20
                                  .Top = 94
                                  .Width = 518
                                  .Height = 28
                              End With
                            End With

Manchmal ist es günstiger mit dem Index der Shapes zu arbeiten.

Die Zeile "Exit Function" müsste eigentlich auch Probleme bereiten. Ich würde hier
Exit For
oder
Exit Sub
erwarten.

Gruß
Franz


  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: Paddy_P
Geschrieben am: 09.10.2014 08:51:05

Hallo

und Danke.
(Ich hab irgendwie keine Bestätigungsmail bekommen, dass du geantwortet hast... daher hab ich jetzt erst gesehn...)

Also ich habs so ausprobiert: und naja.. es läuft jetzt weiter, allerdings macht das Programm das Falsche... es nimmt jetzt das erste Shape, die eh schon im Slide eingefügt war und verschiebt es etc...

Also so unterm Strich nicht ganz das was ich wollte...


Ich hab das Gefühl, dass VBA nur kurzfristig Beschäftigt sein sollte (aber dabei nix in der Präsentation veränder) oder ein Refresh bräuchte damit alles so funktioniert wie es sollte...


Die Exit Function... ist etwas das ich übersehen hab... eigentlich ist das kein Sub sondern eine Function ;)


  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: Paddy_P
Geschrieben am: 09.10.2014 13:18:05

Hat keiner eine Idee?

ich hab jetzt verschiedene Sache versucht - meistens etwas um vba andersweitig zu beschäftigen, sodass dann später wieder zum Befehl zurücgekommen wird...

Leider war ich bisher absolut erfolglos.


  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: fcs
Geschrieben am: 09.10.2014 14:07:48

Hallo Paddy,

ich hab auch noch rumprobiert.
Ich hab z.B. versucht mit PasteSpecial den in Excel koierten Zellbereich in der Folie einzufügen statt den Befehl der CommandBar auszulösen.. Aber auch hier funktioniert es nicht immer.
Das Problem ist das Element, dass zum Zeitpunkt des Einfügens den Focus hat.
Selektiert man die Folie, dann ist der Fokus links auf der Kleindarstellung der Folien. In diesem Zustand funktioniert das Einfügen nicht, klickt man dann in das eigentliche Folien-Fenster, dann wechselt der Fokus und das Einfügen via PasteSpecial funktioniert inkl. der nachfolgendne Anpassung von Größe und Position. Ich hab aber noch keinen Weg gefunden den Fokus konsequent per VBA auf den richtigen Bereich zu setzen.

Ich muss zu Hause nochmals einige PP-Dateien prüfen, da ich schon erfolgreich eine größere Zahl von Excelzellbereichen in eine PP-Datei transferiert hab.

Gruß
Franz


  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: Paddy_P
Geschrieben am: 09.10.2014 14:48:33

Hallo Franz,

erst mal ein Danke!

Was das Einfügen betrifft: da ich da vorher schon Probleme hatte und es nur wirklich mit "Commandbars.ExecuteMso" klappt, sollte das nicht verändert werden (hab mich damit auch mehrere Tage beschäftigt bis ich diese Lösung gefunden hab).

Was ich einfach nicht verstehe, dass wenn ich das Skript mit F5 laufen lasse, gibt es Probleme... die aber mit F8 gelöst werden können...

Dann hoffe ich mal du findest ne geeignete Lösung. :)

Gruß Paddy


  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: fcs
Geschrieben am: 10.10.2014 13:19:58

Hallo Paddy,

ich hab bis jetzt nur eine Teillösung gefunden.
Durch Anzeige einer Pop-Up-Message nach dem Einfügen funktioniert die Aktualisierung der Shapezählung.

Beim Testen hatte ich außerdem das Problem, dass manchmal der Zellbereich aus Excel auf der 1. Folie eingefügt wurde. Im Makro wird deshalb auch die Fensterdarstellung während des Einfügens angepasst.

Leider blendet sich die Pop-Up-Box nicht automatisch nach 1 Sekunde aus, wie es eigentlich sein sollte. Keine Ahnung was da los ist.

Was mich weiter wundert: Als Parameter deiner Sub hast du LC und lc also einmal Groß- einmal Kleinschreibung. Das funktioniert unter Windows/Excel nicht. In welcher Umgebung erstellst du denn dein Makro?

Gruß
Franz

'Erstellt unter Windows 7, MS Office 2010
Function fncPopUpMessage(strText As String, Optional intSekunden As Integer = 0, _
      Optional strTitel As String = "info", Optional intType As Integer = 0) As Integer 'neu
    Dim objShell As Object
    Set objShell = CreateObject("WScript.Shell")
    fncPopUpMessage = objShell.Popup(strText, intSekunden, strTitel, intType)
    Set objShell = Nothing
End Function

Sub Einfuegen(LCn, pptPres, SS, lc, EDB) 'Variablenname geändert
    Dim msE As Object
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim objPPT As Object
    Dim wsh_List As Variant
    Dim i As Long
    Dim j As Long
    
    wsh_List = Array("Datei 1", "Datei 2", "Datei 3", "Datei 4")
    
    Set objPPT = pptPres.Application                'geändert
    
    objPPT.Activate                                 'neu
    With objPPT.ActiveWindow                        'neu
        'blendet Gliedrung und Notizen-Fenster aus
        If .Panes.Count = 1 Then
            .ViewType = 9 'ppViewNormal
        End If
        .SplitHorizontal = 0
        .SplitVertical = 100
    End With

    Set msE = GetObject(, "Excel.Application")
    'Set msE = Excel.Application
    
    For Each wbk In msE.Workbooks
        For Each wsh In wbk.Worksheets
            For i = 0 To 3
                If wsh.Name = wsh_List(i) Then
                    
                    Const a = 4
                    Const b = 5
                    Const c = 4
                    Const d = 6
                    Dim Sld_list As Variant
                    Dim LC_list As Variant
                    
                    Sld_list = Array(a, b, c, d)
                    LC_list = Array("Data 1", "Data 2", "Data 3", "Data 4")
                    
                    For j = 0 To 3
                        If InStr(LCn, LC_list(j)) Then   'Variablenname geändert
                            wsh.Range("C4:" & Chr(64 + lc) & "5").Copy
                            
                            'pptPres.Slides(Sld_list(j)).Select
                            objPPT.ActiveWindow.View.GotoSlide (Sld_list(j))
                            
                            objPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
                            
                            Call fncPopUpMessage("Dummymeldung 1. Shape", 1, "Info", 0) 'neu
                            
'                            With pptPres.Slides(Sld_list(j)).Shapes("Tabelle 1")
      With pptPres.Slides(Sld_list(j)).Shapes(pptPres.Slides(Sld_list(j)).Shapes.Count)
                                
                                .Left = 20
                                .Top = 94
                                .Width = 518
                                .Height = 28
                            End With
                            
                            If InStr(lc, "Data 1") Then
                              wsh.Range(Chr(67) & SS & ":" & Chr(64 + lc) & _
                                  EDB + 1).Copy
                              objPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
                            Else
                              wsh.Range(Chr(67) & SS & ":" & Chr(64 + lc) & _
                                  EDB).Copy
                              objPPT.CommandBars.ExecuteMso ("PasteSourceFormatting")
                            End If
                            
                            Call fncPopUpMessage("Dummymeldung 2. Shape", 1, "Info", 0) 'neu

'                            With pptPres.Slides(Sld_list(j)).Shapes("Tabelle 2")
      With pptPres.Slides(Sld_list(j)).Shapes(pptPres.Slides(Sld_list(j)).Shapes.Count)
                                
                                .Left = 20
                                .Top = 150
                                .Width = 518
                                .Height = 322
                            End With
                            
                            With objPPT.ActiveWindow                        'neu
                                'blendet Gliedrung und Notizen-Fenster ein
                                .SplitHorizontal = 15
                                .SplitVertical = 90
                            End With
                            Exit Sub
                            
                        End If
                    Next
                End If
            Next
        Next
    Next
End Sub



  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: Paddy_P
Geschrieben am: 10.10.2014 16:49:09

Hallo Franz,

nochmals Danke für die Mühen.

Ich werde wohl nicht vor Montag dazu kommen das Skript zu testen...
Daher werde ich mich erst wieder nächste Woche melden, ob es klappt.


Generell noch zu den Variablen: Ich verwende in meinen Skript andere Variablen (wesentlich längere). Hab das hier aus Übersichtlichkeitsgründen einfach kürzer gemacht, ohne darüber nachzudenken, ob das überhaupt funktioniert...

Gruß Patrick


  

Betrifft: AW: VBA PP auf kürzlich erstelltes Shape zugreifen von: Paddy_P
Geschrieben am: 13.10.2014 14:29:38

Hallo,

also ich habs ausprobiert:
Bis auf das auf OK-drücken ist es für mich in Ordnung.

Und das OK-Drücken... is zwar ein kleines Problem... Aber ich bin mir sicher, dass zukünftige User, dass bewerkstelligt bekommen sollten.

Von daher nochmals Danke für die Hilfe!


 

Beiträge aus den Excel-Beispielen zum Thema "VBA PP auf kürzlich erstelltes Shape zugreifen"