【发布时间】:2015-12-13 19:50:24
【问题描述】:
Power Point 2016
我想隐藏一个形状,但我不希望用户能够以编程方式取消隐藏它
shape.visible = xlVeryHidden
【问题讨论】:
标签: vba powerpoint
Power Point 2016
我想隐藏一个形状,但我不希望用户能够以编程方式取消隐藏它
shape.visible = xlVeryHidden
【问题讨论】:
标签: vba powerpoint
可以使用 PowerPoint 事件以编程方式执行此操作,以检测对“标记”形状的选择,将其隐藏然后取消选择。我之前在我的几个 PowerPoint 插件产品中使用过这种机制,并且效果很好。它需要以下元素:
这是经过测试的代码:(不是生产质量,例如,不处理非幻灯片视图)
在名为“clsAppEvents”的类模块中:
' Source code provided by youpresent.co.uk
Option Explicit
Public WithEvents App As Application
Private Sub App_WindowSelectionChange(ByVal Sel As Selection)
Debug.Print "Event : App_WindowSelectionChange"
If Sel.Type = ppSelectionShapes Then CheckSelection
End Sub
Private Sub App_PresentationClose(ByVal Pres As Presentation)
StopTimer
End Sub
在一个名为“Main”的标准模块中:
' Source code provided by youpresent.co.uk
Option Explicit
'Create a new event handler object from the event class
Public oEH As New clsAppEvents
' Ribbon callback to initialise PowerPoint events
Public Sub OnLoadRibbon(ribbon As IRibbonUI)
Set oEH.App = Application
Debug.Print "PowerPoint App Events Initialised"
StartTimer
End Sub
' Timer initiated check to see if Very Hidden shapes have been unhidden using the Selection Pane
Public Sub CheckShapes()
Dim lCurSlide As Long
Dim oShp As Shape
Dim bFound As Boolean
lCurSlide = ActiveWindow.View.Slide.SlideIndex
For Each oShp In ActivePresentation.Slides(lCurSlide).Shapes
If oShp.Name = "VeryHidden" Then oShp.Visible = msoFalse
Next
End Sub
' Selection change event initialised check to see if selection is Very Hidden
Public Sub CheckSelection()
Dim oShp As Shape
Dim bFound As Boolean
StopTimer
For Each oShp In ActiveWindow.Selection.ShapeRange
If oShp.Name = "VeryHidden" Then
oShp.Visible = msoFalse
bFound = True
End If
Next
If bFound Then ActiveWindow.Selection.Unselect
StartTimer
End Sub
在一个名为“WinTimer”的标准模块中:
' Source code provided by youpresent.co.uk
Option Explicit
Public TimerID As Long
Public TimerCycles As Long
' Source : https://support.microsoft.com/kb/180736?wa=wsignin1.0
#If VBA7 Then
Private Declare PtrSafe Function SetTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr, _
ByVal uElapse As LongPtr, _
ByVal lpTimerFunc As LongPtr) As LongPtr
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As LongPtr, _
ByVal nIDEvent As LongPtr) As LongPtr
#Else
Private Declare Function SetTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long, _
ByVal uElapse As Long, _
ByVal lpTimerFunc As Long) As Long
Private Declare Function KillTimer Lib "user32" _
(ByVal hwnd As Long, _
ByVal nIDEvent As Long) As Long
#End If
' Starts the time with uElapse time-out period in milliseconds
Public Function StartTimer()
TimerID = SetTimer(0, 0, 100, AddressOf TimerProc)
If TimerID = 0 Then Debug.Print "Timer not created.": Exit Function
Debug.Print "Timer " & TimerID & " started at : " & Now
End Function
Private Function TimerProc(ByVal hwnd As Long, _
ByVal uMsg As Long, _
ByVal idEvent As Long, _
ByVal dwTime As Long)
TimerCycles = TimerCycles + 1
If TimerCycles Mod 10 = 0 Then Debug.Print "Timer " & TimerID & " running : " & TimerCycles
CheckShapes
End Function
Public Function StopTimer()
Dim tmpTimerID As Long
tmpTimerID = TimerID
' If the KillTimer function succeeds, the return value is nonzero.
' If the KillTimer function fails, the return value is zero.
TimerID = KillTimer(0, TimerID)
If TimerID = 0 Then
Debug.Print "Couldn't kill the timer"
Else
Debug.Print "Timer " & tmpTimerID & " stopped at : " & Now & " with " & TimerCycles & " cycles"
End If
TimerCycles = 0
TimerID = 0
End Function
最后,将此功能区 XML 添加到启用宏的 pptm/ppam/ppsm/potm 文件中:
<customUI onLoad="OnLoadRibbon" xmlns="http://schemas.microsoft.com/office/2006/01/customui"/>
现在,如果您打开启用宏的文件并将形状添加到名称为“VeryHidden”的任何幻灯片,您应该无法通过 PowerPoint UI 取消隐藏它。当然,应该使用标签而不是名称,但这只是为了证明这个概念。
【讨论】:
PowerPoint 中没有这样的等价物。任何隐藏的形状都可以从选择窗格中显示出来。
【讨论】: