Sub ZellenInhaltAbholenUndWeitergeben()
Dim rngDatenWerte As Range
Dim appPowerPt As Variant
Dim strWerte As String
Dim myDocument As Variant
Dim I As Integer
Dim A As Integer
Set rngDatenWerte = Worksheets(2).Range("A1:O12")
rngDatenWerte.Select
For I = 1 To rngDatenWerte.Rows.Count
strWerte = strWerte & CStr(rngDatenWerte.Cells(I, 1)) & "; "
Next
strWerte = Left(strWerte, (Len(strWerte) - 2))
Set appPowerPt = CreateObject("PowerPoint.Application")
appPowerPt.Visible = True
appPowerPt.Presentations.Open Filename:="c:\Monatsbericht TZE.ppt"
Set myDocument = appPowerPt.Presentations(1).Slides(10)
With myDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, _
260, 285, 200, 100).TextFrame.TextRange
.Text = "" & strWerte
.ParagraphFormat.Alignment = ppAlignCenter
With .Font
.Italic = False
.Name = "Times New Roman"
.Color.RGB = RGB(0, 0, 0)
.Bold = True
.Size = 40
End With
End With
End Sub
Gruß Redneck