How to update information within unrelated excel objects inserted in slides of a presentation
' ====== Class Module - EventClass =====
Option Explicit
Public WithEvents App As Excel.Application
Private Sub App_WorkbookDeactivate(ByVal Wb As Excel.Workbook)
Call UpdateXLCells
End Sub
' ====== End Of Class Module - EventClass =====
' ======= Module =======
Option Explicit
' ------ Code Specific to Hooking into Excel Events -----
Dim AppClass As New EventClass
Sub SetExcelHook()
Set AppClass.App = Excel.Application
End Sub
Sub UnHook()
AppClass.App = Nothing
End Sub
' ------ End Of Code Specific to Hooking into Excel Events -----
Sub UpdateXLCells()
Dim X As Integer
Dim Y As Variant
For X = 2 To 4
Y = Y + GetXlRngValues(ActivePresentation.Slides(X).Shapes(1), "B2")
Next
SetXlRngValues ActivePresentation.Slides(1).Shapes(1), "B2", Y
End Sub
Function GetXlRngValues(oShape As PowerPoint.Shape, _
Rng As String) As Variant
Dim XLObj As Excel.Workbook
Dim CellValues As Variant
Set XLObj = oShape.OLEFormat.Object
GetXlRngValues = XLObj.Worksheets(1).Range(Rng)
End Function
Sub SetXlRngValues(oShape As PowerPoint.Shape, _
Rng As String, Value As Variant)
Dim XLObj As Excel.Workbook
Dim CellValues As Variant
Set XLObj = oShape.OLEFormat.Object
XLObj.Worksheets(1).Range(Rng) = Value
End Sub
' ===== End Of Code =====
H0UZNPRO.rar
(33.04 KB, 下载次数: 21)
|