ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Excel VB Code (https://www.excelbanter.com/excel-programming/408908-excel-vbulletin-code.html)

Ranjit kurian

Excel VB Code
 
Hi

I have created a excel vb code to copy the pivots from excel to powerpoint
slide.

The problem iam facing is, unable to create a Textbox in the same active
powerpoint slide.

Could you please help me to write an excel vb code in excel, so that i can
add a text box to the active window powerpoint slide.

Below is the code i tried in excel macro,

while running its asking for an object.

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim slidecount As Long
Dim ans
Dim answer As String
Dim RangetoPaste As Range
Dim PPShape As Shape

ActiveWindow.Selection.SlideRange.Shapes.AddTextbo xmsoTextOrientationHorizontal, 50, 50, 400, 24).Select
ActiveWindow.Selection.ShapeRange.TextFrame.Wordwr ap

Steve Yandl

Excel VB Code
 
When you write ActiveWindow.Selection....inside VBA running from an Excel
workbook, the 'ActiveWindow' is the active window for Excel, not your
PowerPoint presentation. You're not showing enough of your code to make any
specific suggestions.

Steve



"Ranjit kurian" wrote in message
...
Hi

I have created a excel vb code to copy the pivots from excel to powerpoint
slide.

The problem iam facing is, unable to create a Textbox in the same active
powerpoint slide.

Could you please help me to write an excel vb code in excel, so that i can
add a text box to the active window powerpoint slide.

Below is the code i tried in excel macro,

while running its asking for an object.

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim slidecount As Long
Dim ans
Dim answer As String
Dim RangetoPaste As Range
Dim PPShape As Shape

ActiveWindow.Selection.SlideRange.Shapes.AddTextbo xmsoTextOrientationHorizontal,
50, 50, 400, 24).Select
ActiveWindow.Selection.ShapeRange.TextFrame.Wordwr ap




Ranjit kurian

Excel VB Code
 
Hi Steve,

Below is my excel macro code which open the powerpoint application of
previous week then delete the existing pictures and copy the new pictures
from excel sheet, till here its working fine for me , but after doing all
these things i need my excel macro to add text box to ppt slide and type a
text given by me.

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim slidecount As Long
Dim ans
Dim answer As String
Dim RangetoPaste As Range
Dim PPShape As Shape

'Open ppt file
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Open("C:\Ranjith
Report\AR\Top5\Macro\Business Direct- Business Review.ppt",
ReadOnly:=msoFalse)

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.View.GotoSlide 1
PPApp.ActiveWindow.ViewType = ppViewSlide

PPApp.ActiveWindow.Selection.sliderange.Shapes.Sel ectAll
PPApp.ActiveWindow.Selection.ShapeRange.Delete

slidecount = PPPres.slides.Count
Set PPSlide =
PPPres.slides(PPApp.ActiveWindow.Selection.slidera nge.SlideIndex)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
PPSlide.Shapes.Paste.Select

PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignmiddle, True

PPApp.ActiveWindow.Selection.ShapeRange.IncrementL eft -28.5
PPApp.ActiveWindow.Selection.ShapeRange.IncrementT op -148.62
PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.96, msoFalse,
msoScaleFromTopLeft
PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.97, msoFalse,
msoScaleFromBottomRight
PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeigh t 1.46, msoFalse,
msoScaleFromTopLeft

'OtherPart

Windows("Regional Graphs Presentation.xls").Activate
Sheets("Billing-Not Paying Top 5").Select
Range("B4:J10").Select
Selection.EntireColumn.Hidden = True
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.View.GotoSlide 1
PPApp.ActiveWindow.ViewType = ppViewSlide

slidecount = PPPres.slides.Count
Set PPSlide =
PPPres.slides(PPApp.ActiveWindow.Selection.slidera nge.SlideIndex)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
PPSlide.Shapes.Paste.Select

PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignmiddle, True

PPApp.ActiveWindow.Selection.ShapeRange.IncrementL eft 56.75
PPApp.ActiveWindow.Selection.ShapeRange.IncrementT op 124.12
PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1.18, msoFalse,
msoScaleFromTopLeft
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
'PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidt h 1.06, msoFalse,
msoScaleFromBottomRight
PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeigh t 1.39, msoFalse,
msoScaleFromTopLeft

"Steve Yandl" wrote:

When you write ActiveWindow.Selection....inside VBA running from an Excel
workbook, the 'ActiveWindow' is the active window for Excel, not your
PowerPoint presentation. You're not showing enough of your code to make any
specific suggestions.

Steve



"Ranjit kurian" wrote in message
...
Hi

I have created a excel vb code to copy the pivots from excel to powerpoint
slide.

The problem iam facing is, unable to create a Textbox in the same active
powerpoint slide.

Could you please help me to write an excel vb code in excel, so that i can
add a text box to the active window powerpoint slide.

Below is the code i tried in excel macro,

while running its asking for an object.

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim slidecount As Long
Dim ans
Dim answer As String
Dim RangetoPaste As Range
Dim PPShape As Shape

ActiveWindow.Selection.SlideRange.Shapes.AddTextbo xmsoTextOrientationHorizontal,
50, 50, 400, 24).Select
ActiveWindow.Selection.ShapeRange.TextFrame.Wordwr ap





Steve Yandl

Excel VB Code
 
I just glanced quickly at your code.

Correct me if I've drawn any wrong conclusions. It appears you want to copy
a range from the active Excel sheet with the upper left corner being cell A4
(after hiding columns B through J). You want to copy this range (or a
picture of it), open your existing PowerPoint presentation, get rid of
everyting on slide one of this presentation and then paste the picture from
Excel. Then you move and resize the image on your slide. Now, you would
like to be able to add a text box to slide 1 and enter text in it.

I see you've set a variable to the slide count so I'm guessing you are
working with multiple slides. Is that the case?


Steve


"Ranjit kurian" wrote in message
...
Hi Steve,

Below is my excel macro code which open the powerpoint application of
previous week then delete the existing pictures and copy the new pictures
from excel sheet, till here its working fine for me , but after doing all
these things i need my excel macro to add text box to ppt slide and type a
text given by me.

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim slidecount As Long
Dim ans
Dim answer As String
Dim RangetoPaste As Range
Dim PPShape As Shape

'Open ppt file
Set PPApp = CreateObject("PowerPoint.Application")
PPApp.Visible = True
Set PPPres = PPApp.Presentations.Open("C:\Ranjith
Report\AR\Top5\Macro\Business Direct- Business Review.ppt",
ReadOnly:=msoFalse)

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.View.GotoSlide 1
PPApp.ActiveWindow.ViewType = ppViewSlide

PPApp.ActiveWindow.Selection.sliderange.Shapes.Sel ectAll
PPApp.ActiveWindow.Selection.ShapeRange.Delete

slidecount = PPPres.slides.Count
Set PPSlide =
PPPres.slides(PPApp.ActiveWindow.Selection.slidera nge.SlideIndex)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
PPSlide.Shapes.Paste.Select

PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignmiddle, True

PPApp.ActiveWindow.Selection.ShapeRange.IncrementL eft -28.5
PPApp.ActiveWindow.Selection.ShapeRange.IncrementT op -148.62
PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.96, msoFalse,
msoScaleFromTopLeft
PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 0.97, msoFalse,
msoScaleFromBottomRight
PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeigh t 1.46, msoFalse,
msoScaleFromTopLeft

'OtherPart

Windows("Regional Graphs Presentation.xls").Activate
Sheets("Billing-Not Paying Top 5").Select
Range("B4:J10").Select
Selection.EntireColumn.Hidden = True
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Set PPApp = GetObject(, "Powerpoint.Application")
Set PPPres = PPApp.ActivePresentation
PPApp.ActiveWindow.View.GotoSlide 1
PPApp.ActiveWindow.ViewType = ppViewSlide

slidecount = PPPres.slides.Count
Set PPSlide =
PPPres.slides(PPApp.ActiveWindow.Selection.slidera nge.SlideIndex)
Selection.CopyPicture Appearance:=xlScreen, _
Format:=xlBitmap
PPSlide.Shapes.Paste.Select

PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignmiddle, True

PPApp.ActiveWindow.Selection.ShapeRange.IncrementL eft 56.75
PPApp.ActiveWindow.Selection.ShapeRange.IncrementT op 124.12
PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidth 1.18, msoFalse,
msoScaleFromTopLeft
PPApp.ActiveWindow.Selection.ShapeRange.Align msoAlignCenters, True
'PPApp.ActiveWindow.Selection.ShapeRange.ScaleWidt h 1.06, msoFalse,
msoScaleFromBottomRight
PPApp.ActiveWindow.Selection.ShapeRange.ScaleHeigh t 1.39, msoFalse,
msoScaleFromTopLeft

"Steve Yandl" wrote:

When you write ActiveWindow.Selection....inside VBA running from an Excel
workbook, the 'ActiveWindow' is the active window for Excel, not your
PowerPoint presentation. You're not showing enough of your code to make
any
specific suggestions.

Steve



"Ranjit kurian" wrote in message
...
Hi

I have created a excel vb code to copy the pivots from excel to
powerpoint
slide.

The problem iam facing is, unable to create a Textbox in the same
active
powerpoint slide.

Could you please help me to write an excel vb code in excel, so that i
can
add a text box to the active window powerpoint slide.

Below is the code i tried in excel macro,

while running its asking for an object.

Dim PPApp As PowerPoint.Application
Dim PPPres As PowerPoint.Presentation
Dim PPSlide As PowerPoint.Slide
Dim slidecount As Long
Dim ans
Dim answer As String
Dim RangetoPaste As Range
Dim PPShape As Shape

ActiveWindow.Selection.SlideRange.Shapes.AddTextbo xmsoTextOrientationHorizontal,
50, 50, 400, 24).Select
ActiveWindow.Selection.ShapeRange.TextFrame.Wordwr ap







Steve Yandl

Excel VB Code
 
See if this example gives you any ideas.

Steve


Sub UpdatePPTslide()

Dim myRange As Range
Dim ppApp As PowerPoint.Application
Dim prsPres As PowerPoint.Presentation
Dim currShapeRange As PowerPoint.ShapeRange
Dim currShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

' Copy range from Sheet2 of active workbook
Set myRange = Sheets(2).UsedRange
myRange.Copy


' Open and reference the presentation, MyShow.ppt
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = msoTrue
Set prsPres = ppApp.Presentations.Open("C:\Test\MyShow.ppt")
' Get dimensions of a slide
lngSlideHeight = prsPres.PageSetup.SlideHeight
lngSlideWidth = prsPres.PageSetup.SlideWidth

' Delete all shapes on Slide 1 of MyShow.ppt
' Paste Excel range
With prsPres.Slides(1)
If .Shapes.Count 0 Then
.Shapes.Range.Delete
End If
Set currShapeRange = .Shapes.PasteSpecial
End With

' Resize the pasted Excel range
With currShapeRange
.ScaleHeight 1.2, msoFalse
.ScaleWidth 1.1, msoFalse
End With

' Add text box with text to Slide 1
Set currShape = prsPres.Slides(1).Shapes _
.AddTextbox(msoTextOrientationHorizontal, 20, 20, 500, 500)
With currShape
With .TextFrame.TextRange
.Text = "This is just an experiment"
With .ParagraphFormat
.Alignment = ppAlignLeft
.Bullet = msoFalse
End With
With .Font
.Bold = msoTrue
.Name = "Tahoma"
.Size = 24
End With
End With
' Shrink text box to text it now contains
..Width = .TextFrame.TextRange.BoundWidth
..Height = .TextFrame.TextRange.BoundHeight
End With

' Save changes, close presentation and quit PowerPoint
prsPres.Save
prsPres.Close
ppApp.Quit
Set prsPres = Nothing
Set ppApp = Nothing
End Sub


"Ranjit kurian" wrote in message
...
Hi Steve,

Below is my excel macro code which open the powerpoint application of
previous week then delete the existing pictures and copy the new pictures
from excel sheet, till here its working fine for me , but after doing all
these things i need my excel macro to add text box to ppt slide and type a
text given by me.




Ranjit kurian

Excel VB Code
 
Hi Steve,

when i only copied add textbox code from your macro its not working, same as
the below manner i copied it, actually i want the macro to create a new
textbox, please help me...

Dim myRange As Range
Dim currShapeRange As PowerPoint.ShapeRange
Dim currShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

' Add text box with text to Slide 1
Set currShape = PPPres.slides(1).Shapes _
..AddTextbox(msoTextOrientationHorizontal, 20, 20, 500, 500)
With currShape
With .TextFrame.textrange
..Text = "This is just an experiment"
With .ParagraphFormat
..Alignment = ppAlignLeft
..Bullet = msoFalse
End With
With .Font
..Bold = msoTrue
..Name = "Tahoma"
..Size = 24
End With
End With
'' Shrink text box to text it now contains
'width = .TextFrame.textrange.BoundWidth
'height = .TextFrame.textrange.BoundHeight
End With

"Steve Yandl" wrote:

See if this example gives you any ideas.

Steve


Sub UpdatePPTslide()

Dim myRange As Range
Dim ppApp As PowerPoint.Application
Dim prsPres As PowerPoint.Presentation
Dim currShapeRange As PowerPoint.ShapeRange
Dim currShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

' Copy range from Sheet2 of active workbook
Set myRange = Sheets(2).UsedRange
myRange.Copy


' Open and reference the presentation, MyShow.ppt
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = msoTrue
Set prsPres = ppApp.Presentations.Open("C:\Test\MyShow.ppt")
' Get dimensions of a slide
lngSlideHeight = prsPres.PageSetup.SlideHeight
lngSlideWidth = prsPres.PageSetup.SlideWidth

' Delete all shapes on Slide 1 of MyShow.ppt
' Paste Excel range
With prsPres.Slides(1)
If .Shapes.Count 0 Then
.Shapes.Range.Delete
End If
Set currShapeRange = .Shapes.PasteSpecial
End With

' Resize the pasted Excel range
With currShapeRange
.ScaleHeight 1.2, msoFalse
.ScaleWidth 1.1, msoFalse
End With

' Add text box with text to Slide 1
Set currShape = prsPres.Slides(1).Shapes _
.AddTextbox(msoTextOrientationHorizontal, 20, 20, 500, 500)
With currShape
With .TextFrame.TextRange
.Text = "This is just an experiment"
With .ParagraphFormat
.Alignment = ppAlignLeft
.Bullet = msoFalse
End With
With .Font
.Bold = msoTrue
.Name = "Tahoma"
.Size = 24
End With
End With
' Shrink text box to text it now contains
..Width = .TextFrame.TextRange.BoundWidth
..Height = .TextFrame.TextRange.BoundHeight
End With

' Save changes, close presentation and quit PowerPoint
prsPres.Save
prsPres.Close
ppApp.Quit
Set prsPres = Nothing
Set ppApp = Nothing
End Sub


"Ranjit kurian" wrote in message
...
Hi Steve,

Below is my excel macro code which open the powerpoint application of
previous week then delete the existing pictures and copy the new pictures
from excel sheet, till here its working fine for me , but after doing all
these things i need my excel macro to add text box to ppt slide and type a
text given by me.





Steve Yandl

Excel VB Code
 
The code tested fine on my machine. Perhaps I can provide an abbreviated
version that can be used for troubleshooting.

I don't do that much VBA with PowerPoint but one of the frustrating things
I've discovered is that it's very easy to end up with an instance lingering
in memory after a routine fails due to some error when testing new
subroutines. I've found that if I do have a crash, it's worth it to open
PowerPoint from a shortcut and then close it before attempting to run new
VBA. Like Outlook, PowerPoint will only allow a single instance running at
one time so I think that the open and close routine purges any rougue PP
presentations.

Steve


"Ranjit kurian" wrote in message
...
Hi Steve,

when i only copied add textbox code from your macro its not working, same
as
the below manner i copied it, actually i want the macro to create a new
textbox, please help me...

Dim myRange As Range
Dim currShapeRange As PowerPoint.ShapeRange
Dim currShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

' Add text box with text to Slide 1
Set currShape = PPPres.slides(1).Shapes _
.AddTextbox(msoTextOrientationHorizontal, 20, 20, 500, 500)
With currShape
With .TextFrame.textrange
.Text = "This is just an experiment"
With .ParagraphFormat
.Alignment = ppAlignLeft
.Bullet = msoFalse
End With
With .Font
.Bold = msoTrue
.Name = "Tahoma"
.Size = 24
End With
End With
'' Shrink text box to text it now contains
'width = .TextFrame.textrange.BoundWidth
'height = .TextFrame.textrange.BoundHeight
End With

"Steve Yandl" wrote:

See if this example gives you any ideas.

Steve


Sub UpdatePPTslide()

Dim myRange As Range
Dim ppApp As PowerPoint.Application
Dim prsPres As PowerPoint.Presentation
Dim currShapeRange As PowerPoint.ShapeRange
Dim currShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

' Copy range from Sheet2 of active workbook
Set myRange = Sheets(2).UsedRange
myRange.Copy


' Open and reference the presentation, MyShow.ppt
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = msoTrue
Set prsPres = ppApp.Presentations.Open("C:\Test\MyShow.ppt")
' Get dimensions of a slide
lngSlideHeight = prsPres.PageSetup.SlideHeight
lngSlideWidth = prsPres.PageSetup.SlideWidth

' Delete all shapes on Slide 1 of MyShow.ppt
' Paste Excel range
With prsPres.Slides(1)
If .Shapes.Count 0 Then
.Shapes.Range.Delete
End If
Set currShapeRange = .Shapes.PasteSpecial
End With

' Resize the pasted Excel range
With currShapeRange
.ScaleHeight 1.2, msoFalse
.ScaleWidth 1.1, msoFalse
End With

' Add text box with text to Slide 1
Set currShape = prsPres.Slides(1).Shapes _
.AddTextbox(msoTextOrientationHorizontal, 20, 20, 500, 500)
With currShape
With .TextFrame.TextRange
.Text = "This is just an experiment"
With .ParagraphFormat
.Alignment = ppAlignLeft
.Bullet = msoFalse
End With
With .Font
.Bold = msoTrue
.Name = "Tahoma"
.Size = 24
End With
End With
' Shrink text box to text it now contains
..Width = .TextFrame.TextRange.BoundWidth
..Height = .TextFrame.TextRange.BoundHeight
End With

' Save changes, close presentation and quit PowerPoint
prsPres.Save
prsPres.Close
ppApp.Quit
Set prsPres = Nothing
Set ppApp = Nothing
End Sub


"Ranjit kurian" wrote in message
...
Hi Steve,

Below is my excel macro code which open the powerpoint application of
previous week then delete the existing pictures and copy the new
pictures
from excel sheet, till here its working fine for me , but after doing
all
these things i need my excel macro to add text box to ppt slide and
type a
text given by me.







Ranjit kurian

Excel VB Code
 
Hi Steve,

Thanks a lot, your advise helped me....

"Steve Yandl" wrote:

The code tested fine on my machine. Perhaps I can provide an abbreviated
version that can be used for troubleshooting.

I don't do that much VBA with PowerPoint but one of the frustrating things
I've discovered is that it's very easy to end up with an instance lingering
in memory after a routine fails due to some error when testing new
subroutines. I've found that if I do have a crash, it's worth it to open
PowerPoint from a shortcut and then close it before attempting to run new
VBA. Like Outlook, PowerPoint will only allow a single instance running at
one time so I think that the open and close routine purges any rougue PP
presentations.

Steve


"Ranjit kurian" wrote in message
...
Hi Steve,

when i only copied add textbox code from your macro its not working, same
as
the below manner i copied it, actually i want the macro to create a new
textbox, please help me...

Dim myRange As Range
Dim currShapeRange As PowerPoint.ShapeRange
Dim currShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

' Add text box with text to Slide 1
Set currShape = PPPres.slides(1).Shapes _
.AddTextbox(msoTextOrientationHorizontal, 20, 20, 500, 500)
With currShape
With .TextFrame.textrange
.Text = "This is just an experiment"
With .ParagraphFormat
.Alignment = ppAlignLeft
.Bullet = msoFalse
End With
With .Font
.Bold = msoTrue
.Name = "Tahoma"
.Size = 24
End With
End With
'' Shrink text box to text it now contains
'width = .TextFrame.textrange.BoundWidth
'height = .TextFrame.textrange.BoundHeight
End With

"Steve Yandl" wrote:

See if this example gives you any ideas.

Steve


Sub UpdatePPTslide()

Dim myRange As Range
Dim ppApp As PowerPoint.Application
Dim prsPres As PowerPoint.Presentation
Dim currShapeRange As PowerPoint.ShapeRange
Dim currShape As PowerPoint.Shape
Dim lngSlideHeight As Long
Dim lngSlideWidth As Long

' Copy range from Sheet2 of active workbook
Set myRange = Sheets(2).UsedRange
myRange.Copy


' Open and reference the presentation, MyShow.ppt
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = msoTrue
Set prsPres = ppApp.Presentations.Open("C:\Test\MyShow.ppt")
' Get dimensions of a slide
lngSlideHeight = prsPres.PageSetup.SlideHeight
lngSlideWidth = prsPres.PageSetup.SlideWidth

' Delete all shapes on Slide 1 of MyShow.ppt
' Paste Excel range
With prsPres.Slides(1)
If .Shapes.Count 0 Then
.Shapes.Range.Delete
End If
Set currShapeRange = .Shapes.PasteSpecial
End With

' Resize the pasted Excel range
With currShapeRange
.ScaleHeight 1.2, msoFalse
.ScaleWidth 1.1, msoFalse
End With

' Add text box with text to Slide 1
Set currShape = prsPres.Slides(1).Shapes _
.AddTextbox(msoTextOrientationHorizontal, 20, 20, 500, 500)
With currShape
With .TextFrame.TextRange
.Text = "This is just an experiment"
With .ParagraphFormat
.Alignment = ppAlignLeft
.Bullet = msoFalse
End With
With .Font
.Bold = msoTrue
.Name = "Tahoma"
.Size = 24
End With
End With
' Shrink text box to text it now contains
..Width = .TextFrame.TextRange.BoundWidth
..Height = .TextFrame.TextRange.BoundHeight
End With

' Save changes, close presentation and quit PowerPoint
prsPres.Save
prsPres.Close
ppApp.Quit
Set prsPres = Nothing
Set ppApp = Nothing
End Sub


"Ranjit kurian" wrote in message
...
Hi Steve,

Below is my excel macro code which open the powerpoint application of
previous week then delete the existing pictures and copy the new
pictures
from excel sheet, till here its working fine for me , but after doing
all
these things i need my excel macro to add text box to ppt slide and
type a
text given by me.









All times are GMT +1. The time now is 04:06 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com