stickerman
04-19-2020, 02:13 AM
Hi. I'm a comparatively novice programmer, and have come up with a problem that feels like it should have an easy answer, but I can't find it.
If I manually highlight a cell in Excel, with the word Income in 32point text, then paste it into Powerpoint using the second of the five options (keep formatted text), I get the text, in 32 point, and it is alterable - my aim is to add a drop shadow on all my text.
When using VBA to copy it across I get one of two results, depending on which setting I use. I either get editable text, but at the wrong size (32 point drops to 18 point), or a get the right size, but not editable (i.e. more as a picture).
My code is as follows
Sub CaloutDownArrow179200_Click()
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(Class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
myPresentation.PageSetup.SlideSize = 1
'----------------------------------------------------------------------------------
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 12)
With mySlide
.FollowMasterBackground = msoFalse
.Background.Fill.Solid
.Background.Fill.ForeColor.RGB = RGB(0, 51, 204)
End With
Application.CutCopyMode = False
Set rng = ThisWorkbook.Worksheets("Slide 2").Range("c5")
rng.Copy
'Paste to PowerPoint
mySlide.Shapes.PasteSpecial DataType:=8
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
''''Set myShape = mySlide.Shapes.PasteSpecial(DataType:=8) '8 = ppPasteHTML
''''Application.CutCopyMode = False
myShape.Top = (myPresentation.PageSetup.slideheight - myShape.Height) / 2
myShape.Left = (myPresentation.PageSetup.slidewidth - myShape.Width) / 2
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
I can only assume the problem is the blue text above, sending the text to Powerpoint. I have tried using all different numbers for datatype, but none keeps the size and formatting.
I have also tried replacing the red text with the blue text, but with the same results.
I am using Powerpoint and Excel in Office 365
Can you help me here?
Stickerman
If I manually highlight a cell in Excel, with the word Income in 32point text, then paste it into Powerpoint using the second of the five options (keep formatted text), I get the text, in 32 point, and it is alterable - my aim is to add a drop shadow on all my text.
When using VBA to copy it across I get one of two results, depending on which setting I use. I either get editable text, but at the wrong size (32 point drops to 18 point), or a get the right size, but not editable (i.e. more as a picture).
My code is as follows
Sub CaloutDownArrow179200_Click()
Dim rng As Range
Dim PowerPointApp As Object
Dim myPresentation As Object
Dim mySlide As Object
Dim myShape As Object
'Create an Instance of PowerPoint
On Error Resume Next
'Is PowerPoint already opened?
Set PowerPointApp = GetObject(Class:="PowerPoint.Application")
'Clear the error between errors
Err.Clear
'If PowerPoint is not already open then open PowerPoint
If PowerPointApp Is Nothing Then Set PowerPointApp = CreateObject(Class:="PowerPoint.Application")
'Handle if the PowerPoint Application is not found
If Err.Number = 429 Then
MsgBox "PowerPoint could not be found, aborting."
Exit Sub
End If
On Error GoTo 0
'Optimize Code
Application.ScreenUpdating = False
'Create a New Presentation
Set myPresentation = PowerPointApp.Presentations.Add
myPresentation.PageSetup.SlideSize = 1
'----------------------------------------------------------------------------------
'Add a slide to the Presentation
Set mySlide = myPresentation.Slides.Add(1, 12)
With mySlide
.FollowMasterBackground = msoFalse
.Background.Fill.Solid
.Background.Fill.ForeColor.RGB = RGB(0, 51, 204)
End With
Application.CutCopyMode = False
Set rng = ThisWorkbook.Worksheets("Slide 2").Range("c5")
rng.Copy
'Paste to PowerPoint
mySlide.Shapes.PasteSpecial DataType:=8
Set myShape = mySlide.Shapes(mySlide.Shapes.Count)
''''Set myShape = mySlide.Shapes.PasteSpecial(DataType:=8) '8 = ppPasteHTML
''''Application.CutCopyMode = False
myShape.Top = (myPresentation.PageSetup.slideheight - myShape.Height) / 2
myShape.Left = (myPresentation.PageSetup.slidewidth - myShape.Width) / 2
'Make PowerPoint Visible and Active
PowerPointApp.Visible = True
PowerPointApp.Activate
'Clear The Clipboard
Application.CutCopyMode = False
End Sub
I can only assume the problem is the blue text above, sending the text to Powerpoint. I have tried using all different numbers for datatype, but none keeps the size and formatting.
I have also tried replacing the red text with the blue text, but with the same results.
I am using Powerpoint and Excel in Office 365
Can you help me here?
Stickerman