Activate PowerPoint from Excel

B

Barb Reinhardt

I've found Chip Pearson's article about activating Excel from another
application

http://www.cpearson.com/excel/ActivateExcelMain.aspx

so I'm thinking I can do this. When I look at the list of Window Class
names, I see that NetUIHWND is used for PowerPoint 2007, Word2007 and
Access2007. How does it know to find PowerPoint over Word?

Thanks,
Barb Reinhardt
 
R

Ronald R. Dodge, Jr.

Here's a sample of code that I have used for interacting with MS Project
within Excel VBA. Of course, this is code that is going back some time and
I have tightened down on my coding practices since that time.

Dim MSProj As MSProject.Application, NextTime As Date
Public APTLWS As Worksheet, APTLWB As Workbook, bolPrjCls As Boolean
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

Function TestTransferData(PF As String)
Dim O As Byte ', PF As String
Application.StatusBar = "Opening Project"
O = OpenProjFile(PF)
DoEvents
If O = 0 Then
MsgBox PF & " did not open properly.(Startup)", 48
TestTransferData = 0
Exit Function
End If
Application.StatusBar = "Opening " & PF
O = FindProjWindows(PF)
If O = 0 Then
TestTransferData = 1
MSProj.FileExit (pjDoNotSave)
Exit Function
End If
TestTransferData = 1
Application.StatusBar = "Filtering and Copying " & PF
O = FilterAllTasks
DoEvents
If O = 0 Then
MsgBox PF & " did not open properly.(Proj)", 48
TestTransferData = 0
Exit Function
ElseIf O = 2 Then
TestTransferData = 1
GoTo CloseApp
End If
Application.StatusBar = "Pasting Data"
PasteResults
CloseApp:
Application.StatusBar = "Closing " & PF
MSProj.DisplayAlerts = False
MSProj.FileCloseAll (pjDoNotSave)
DoEvents
MSProj.FileExit (pjDoNotSave)
DoEvents
Set MSProj = Nothing
DoEvents
Sleep (5000)
Application.StatusBar = False
End Function
Function OpenProjFile(PF As String)
StartProject
DoEvents
On Error GoTo ErrHandle
MSProj.Alerts (False)
MSProj.DisplayAlerts = False
Application.DisplayAlerts = False
Application.StatusBar = "Opening " & PF
MSProj.FileOpen Name:=ThisWorkbook.Path & "\" & PF,
OpenPool:=pjPoolAndSharers
DoEvents
'MSProj.DisplayAlerts = True
OpenProjFile = 1
Exit Function

ErrHandle:
OpenProjFile = 0
Set MSProj = Nothing
End Function
Function FindProjWindows(PF As String)
Dim wd As Window, I As Byte, W As Byte, O As Byte
O = 0
W = MSProj.Windows.Count
If W = 1 Then
FindProjWindows = 0
Exit Function
End If
For I = 1 To W
If InStr(1, MSProj.Windows(I).Caption, "Project", 0) > 0 Then
MSProj.Windows(I).Activate
O = 1
End If
Next
If O = 0 Then
O = (ActiveWindow.Index Mod 2) + 1
MSProj.Windows(O).Activate
End If
FindProjWindows = 1
End Function
Sub InsProjNotFound()
If bolPrjCls Then
VBA.SendKeys "{TAB}{TAB}{SPACE}", False
End If
End Sub


--
Thanks,

Ronald R. Dodge, Jr.
Production Statistician
Master MOUS 2000
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top