如何从PowerPoint VBA中引用打开的Excel工作簿？

bvuwiixz 于 2023-03-04 发布在其他

关注(0)|答案(1)|浏览(210)

我正在PowerPoint VBA中编写一个程序，需要将数据添加到Excel工作簿（wbPool，文件路径为wbPoolPath）。
当工作簿未打开时，我的代码可以工作，但当工作簿已打开时，我在引用该工作簿时遇到问题。

Dim wbPool As Excel.Workbook
If isOpen(wbPoolPath) Then ' isOpen returns True if wbPool is already open, returns False if not
    Set wbPool = GetObject(wbPoolPath) ' returns wbPool = Nothing 
Else
    Set wbPool = Excel.Workbooks.Open(wbPoolPath)
End If
If wbPool Is Nothing Then GoTo ErrPoolOpen

GetObject(wbPoolPath)返回Nothing。我猜是我公司的杀毒软件阻止了GetObject的使用。
我尝试了两种不同的方法将GetObject替换为Set wbPool：

'Split is used to get the workbook name from its fullname
Set wbPool = Workbooks(Split(wbPoolPath, "\")(UBound(Split(wbPoolPath, "\"))))

&

'Loops through all workbooks until it matches with wbPool
Dim wb As Excel.Workbook
For Each wb In Excel.Workbooks
    If wb.FullName = wbPoolPath Then
        Set wbPool = wb
        Exit For
    End If
Next wb

两者都返回wbPool = Nothing，而Excel.Workbooks返回“上下文无关”。
防病毒软件为Cylance Protect。

excel

来源：https://stackoverflow.com/questions/73291918/how-to-refer-to-an-open-excel-workbook-from-powerpoint-vba

1条答案

按热度按时间

a2mppw5e1#

我猜您使用的是Windows PC，下面的代码将获取给定工作簿名称的Excel示例

Option Explicit

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
    (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
    ByVal lpsz2 As String) As Long
Private Declare Function IIDFromString Lib "ole32" _
    (ByVal lpsz As Long, ByRef lpiid As GUID) As Long
Private Declare Function AccessibleObjectFromWindow Lib "oleacc" _
    (ByVal hWnd As Long, ByVal dwId As Long, ByRef riid As GUID, _
    ByRef ppvObject As Object) As Long
         
Private Type GUID
    Data1 As Long
    Data2 As Integer
    Data3 As Integer
    Data4(7) As Byte
End Type

Private Const S_OK As Long = &H0
Private Const IID_IDispatch As String = "{00020400-0000-0000-C000-000000000046}"
Private Const OBJID_NATIVEOM As Long = &HFFFFFFF0

Function getXLApp(hWinXL As Long, xlApp As Excel.Application) As Boolean
    Dim hWinDesk As Long, hWin7 As Long
    Dim obj As Object
    Dim iid As GUID
    
    Call IIDFromString(StrPtr(IID_IDispatch), iid)
    hWinDesk = FindWindowEx(hWinXL, 0&, "XLDESK", vbNullString)
    hWin7 = FindWindowEx(hWinDesk, 0&, "EXCEL7", vbNullString)
    
    If AccessibleObjectFromWindow(hWin7, OBJID_NATIVEOM, iid, obj) = S_OK Then
        Set xlApp = obj.Application
        getXLApp = True
    End If

End Function

Function getWorkbook(wkbName As String) As Workbook
    
    Dim hWinXL As Long
    hWinXL = FindWindowEx(0&, 0&, "XLMAIN", vbNullString)
    
    Dim xlApp As Excel.Application
    Dim wb As Excel.Workbook
    
    Do While hWinXL > 0
                
        If getXLApp(hWinXL, xlApp) Then
            For Each wb In xlApp.Workbooks
                If wb.Name = wkbName Then
                    Set getWorkbook = wb
                End If
            Next
        End If
        hWinXL = FindWindowEx(0, hWinXL, "XLMAIN", vbNullString)
    Loop
    
End Function

以上代码基于此SO post。您可以使用

Sub TestIt()

    Dim wkbName As String
    wkbName = "WorkbookName.xlsx"

    Dim wkb As Workbook
    Set wkb = getWorkbook(wkbName)
    
    If wkb Is Nothing Then
        Debug.Print "Not open"
    Else
        Debug.Print "Open"
        wkb.Close False
    End If

End Sub

赞(0）回复(0）举报 2023-03-04

我来回答

如何从PowerPoint VBA中引用打开的Excel工作簿？

1条答案

相关问题

热门标签

最新问答