Hallo zusammen, 

ich habe mir in Excel ein Makro zusammen gebastelt, was mir die Daten (Zellenwerte) aus einem markierten Bereich in Excel (bspw. bestimmter Abschnitt einer Adressliste) nach Powerpoint kopiert und zwar so, dass jeder Wert in einem eigenen Textfeld steht. Gerne hätte ich das am Ende die Textfelder in der gleichen Tabellenstruktur wie in Excel angeordnet sind. Momentan habe ich es versucht, in dem ich den Zähler in der "Shapes.AddTextbox" mit einer Mulitplikation berücksichtige, was aber keine sinnvolle Lösung ist, denn momentan habe ich noch das Problem, dass je nach länge der Textfelder (bspw. bei einem langen Straßennamen) das benachbarte Textfeld überlappt! d. h. ich hätte gerne in dem Code eine dynamische Anordnung der Textfelder, um eine Überlappung zu vermeiden. Mein Gedanke wäre, dass per VBA zunächst die markierten Zellen geprüft und dabei die "größte" Zelle, also mit dem längsten Text, ermittelt wird und die Größe einer Variablen zugeordnet wird, die wiedrum in der Shapes.AddTextbox eingefügt wird. Oder alternativ, falls das überhaupt möglich ist, per VBA am Ende die Anzahl der Objekte auf der Powerpoint-Folie automatisch gleichmäßig über die Folie verteilt. BEstenfalls übernimmt der VBA Code auch alle Formatierungen und Spaltenbreiten aus Excel und übertragt sie entpsrechend auf die Textfelder in Powerpoint. Dadurch könnte ich die Formatierung per Excel steuern bevor ich das Makro ausführe. Aber sind nur Ideen und ich bin mir überhaupt nicht sicher, ob das überhaupt funktioniert. 

Freue mich über jeglichen Hinweis / Tipp wie ich dieses Problem lösen könnte. Vielen Dank schon einmal im Voraus!

Mein momentaner Code:

Sub Export_Range_into_Txtfld()

       Dim pp As New PowerPoint.Application
       Dim ppt As PowerPoint.Presentation
       Dim sld As PowerPoint.Slide
       Dim shptxtfld As PowerPoint.Shape
       Dim i As Long, j As Long
       Dim z As Long
       Dim myTextBox As Shape
       Dim SPBreite As Single
       Dim SPBreiteMax As Single
       Dim rng As Excel.Range
       Dim sht As Excel.Worksheet

       Set rng = Selection
       pp.Visible = True
       
       If pp.Presentations.Count = 0 Then
           Set ppt = pp.Presentations.Add
       Else
           Set ppt = pp.ActivePresentation
       End If

        Set sld = ppt.Slides.Add(1, ppLayoutTitleOnly)
        For i = 1 To rng.Rows.Count
            For j = 1 To rng.Columns.Count
                   Set shptxtfld = sld.Shapes.AddTextbox(msoTextOrientationHorizontal, 50 + (i * 50), 100 + (j * 50), 1, 1)
                   shptxtfld.TextFrame.TextRange.Text = rng.Cells(j, i).Text
                   shptxtfld.Width = 200
                    
                        With shptxtfld.TextFrame.TextRange
                        .Font.Name = Arial
                        .Font.Size = 15
                        '.Font.Bold = True
                                              
                        End With
                        
                     'If shptxtfld.TextFrame.TextRange.Characters.Count > 50 Then
                     '   shptxtfld.TextFrame.AutoSize = AutoSizeShapeToFitText
                    'End If
                    
            Next
        Next
        
     'Set myDocument = ActivePresentation.Slides(1)
    
       sld.Shapes.Title.TextFrame.TextRange.Text = _
           rng.Worksheet.Name & " - " & rng.Address

End Sub

Viele Grüße

TR