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
End
With
Next
Next
sld.Shapes.Title.TextFrame.TextRange.Text = _
rng.Worksheet.Name &
" - "
& rng.Address
End
Sub