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
|