Activate Excel Workbook Over PPT

MehmetYıldız

New Member
Joined
Dec 19, 2012
Messages
20
Hi Everyone,

I am using MS 2010 and i have a question about activate the excel workbook over powerpoint?

I opened and closed a ppt file but a blank ppt screen still on. I cannot activate the excel over ppt.

I have to show the frm1 on screen because it has confirmation message.

Could you please help? By the way, i searched at forum but i cannot find any answer :(

My code is like below,


Sub PasteChart()


Application.DisplayAlerts = False
Application.ScreenUpdating = False


On Error GoTo Errp:


Dim ppApp As PowerPoint.Application
Dim ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide
Dim oSld As PowerPoint.Slide
Dim oSh As PowerPoint.Shape


Set ppApp = New PowerPoint.Application
Set ppPres = ppApp.Presentations.Add
Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)


mehmet = Excel.ActiveWorkbook.Name


ppSlide.Select
ActiveChart.ChartArea.Copy


On Error Resume Next


ppSlide.Shapes.PasteSpecial(ppPasteShape, msoFalse, , , , msoFalse).Select


For Each oSld In ppApp.ActivePresentation.Slides
For Each oSh In oSld.Shapes
oSh.LinkFormat.BreakLink
Next
Next


ppSlide.Shapes(1).Copy
ppApp.ActivePresentation.Close


Application.DisplayAlerts = True
Application.ScreenUpdating = True


Workbooks(mehmet).Activate 'Cannot activate the excel. Still PPT blank screen on


With frm1
.Top = Int(((Application.Height / 2) + Application.Top) - (.Height / 2))
.Left = Int(((Application.Width / 2) + Application.Left) - (.Width / 2))
.Show
End With


Set ppApp = Nothing


Exit Sub


Errp:


ppApp.ActivePresentation.Close


Set ppApp = Nothing


Application.DisplayAlerts = True
Application.ScreenUpdating = True


m1 = MsgBox("No Chart Selected. Please Select a Chart to Proceed", vbExclamation, "Dear " & Environ("UserName"))


End Sub
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,802
Hi
I ran your code from Excel and it worked. Anyway, try this:

Code:
Sub PasteChart()


Application.DisplayAlerts = False
Application.ScreenUpdating = False


On Error GoTo Errp:


Dim ppApp As PowerPoint.Application, ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide, oSld As PowerPoint.Slide
Dim oSh As PowerPoint.Shape, mehmet$, m1


Set ppApp = New PowerPoint.Application
Set ppPres = ppApp.Presentations.Add
Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)


mehmet = Excel.ActiveWorkbook.Name
ppSlide.Select
ActiveChart.ChartArea.Copy


'On Error Resume Next


ppSlide.Shapes.PasteSpecial(ppPasteShape, msoFalse, , , , msoFalse).Select


For Each oSld In ppApp.ActivePresentation.Slides
    For Each oSh In oSld.Shapes
        oSh.LinkFormat.BreakLink
    Next
Next


ppSlide.Shapes(1).Copy
'ppApp.ActivePresentation.Close


Application.DisplayAlerts = True
Application.ScreenUpdating = True


'Workbooks(mehmet).Activate 'Cannot activate the excel. Still PPT blank screen on
AppActivate "Microsoft Excel"
With frm1
    .Top = Int(((Application.Height / 2) + Application.Top) - (.Height / 2))
    .Left = Int(((Application.Width / 2) + Application.Left) - (.Width / 2))
    .Show
End With
Set ppApp = Nothing


Exit Sub


Errp:
ppApp.ActivePresentation.Close


Set ppApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True


m1 = MsgBox("No Chart Selected. Please Select a Chart to Proceed", vbExclamation, "Dear " & Environ("UserName"))


End Sub
 

MehmetYıldız

New Member
Joined
Dec 19, 2012
Messages
20
Hi Worf,

Thank you for your answer an interest but when i ran this line

AppActivate "Microsoft Excel"

Excel crashes. I am using excel 2010 by the way

Hi
I ran your code from Excel and it worked. Anyway, try this:

Code:
Sub PasteChart()


Application.DisplayAlerts = False
Application.ScreenUpdating = False


On Error GoTo Errp:


Dim ppApp As PowerPoint.Application, ppPres As PowerPoint.Presentation
Dim ppSlide As PowerPoint.Slide, oSld As PowerPoint.Slide
Dim oSh As PowerPoint.Shape, mehmet$, m1


Set ppApp = New PowerPoint.Application
Set ppPres = ppApp.Presentations.Add
Set ppSlide = ppPres.Slides.Add(1, ppLayoutBlank)


mehmet = Excel.ActiveWorkbook.Name
ppSlide.Select
ActiveChart.ChartArea.Copy


'On Error Resume Next


ppSlide.Shapes.PasteSpecial(ppPasteShape, msoFalse, , , , msoFalse).Select


For Each oSld In ppApp.ActivePresentation.Slides
    For Each oSh In oSld.Shapes
        oSh.LinkFormat.BreakLink
    Next
Next


ppSlide.Shapes(1).Copy
'ppApp.ActivePresentation.Close


Application.DisplayAlerts = True
Application.ScreenUpdating = True


'Workbooks(mehmet).Activate 'Cannot activate the excel. Still PPT blank screen on
AppActivate "Microsoft Excel"
With frm1
    .Top = Int(((Application.Height / 2) + Application.Top) - (.Height / 2))
    .Left = Int(((Application.Width / 2) + Application.Left) - (.Width / 2))
    .Show
End With
Set ppApp = Nothing


Exit Sub


Errp:
ppApp.ActivePresentation.Close


Set ppApp = Nothing
Application.DisplayAlerts = True
Application.ScreenUpdating = True


m1 = MsgBox("No Chart Selected. Please Select a Chart to Proceed", vbExclamation, "Dear " & Environ("UserName"))


End Sub
 

Worf

Well-known Member
Joined
Oct 30, 2011
Messages
3,802
Can you test the workbook on another computer, preferably with a different Office version?

Can you upload your actual workbook to a hosting site like Dropbox and paste the link here, so that I can test it with Excel 07?
 

MehmetYıldız

New Member
Joined
Dec 19, 2012
Messages
20
Can you test the workbook on another computer, preferably with a different Office version?

Can you upload your actual workbook to a hosting site like Dropbox and paste the link here, so that I can test it with Excel 07?
I worked for Samsung and all the excel files have been encrypted due to the security settings.

Sorry for that :(
 

Forum statistics

Threads
1,081,702
Messages
5,360,743
Members
400,595
Latest member
T_Dubs

Some videos you may like

This Week's Hot Topics

  • VBA (Userform)
    Hi All, I just would like to know why my code isn't working. Here is my VBA code: [CODE=vba]Private Sub OKButton_Click() Dim i As Integer...
  • List box that changes fill color
    Hello, I have gone through so many pages trying to figure this out. I have a 2020 calendar that depending on the day needs to have a certain...
  • Remove duplicates and retain one. Cross-linked cases
    Hi all I ran out of google keywords to use and still couldn't find a reference how to achieve the results of a single count. It would be great if...
  • VBA Copy and Paste With Duplicates
    Hello All, I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is...
  • Macro
    is it possible for a macro to run if the active cell value is different to the value above it
  • IF DATE and TIME
    I currently use this to check if date has passed but i also need to set a time on it too. Is it possible? [CODE=vba]=IF(B:B>TODAY(),"Not...
Top