Sub TextBox2PPT()

Dim PPApp As Object
Dim PPPres As Object
Dim PPSlide As Object
Dim myFontName As Variant
Dim myFontSize As Long

With Selection.Font
myFontName = .Name
myFontSize = .Size
End With

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.ViewType = 9
Set PPSlide = PPPres.Slides(PPApp.ActiveWindow.Selection. _
SlideRange.SlideIndex)

Selection.Copy

PPSlide.Shapes.Paste.Select

PPApp.ActiveWindow.Selection.ShapeRange.TextFrame. TextRange. _
Font.Size = myFontSize
With PPApp.ActiveWindow.Selection.ShapeRange.TextFrame. _
TextRange.Font
.NameAscii = myFontName
.NameOther = myFontName
.NameFarEast = myFontName
End With

Set PPSlide = Nothing
Set PPPres = Nothing
Set PPApp = Nothing
End Sub