简体   繁体   中英

VBA Power Point equivilant of xlveryhidden

Power Point 2016

I want to hide a shape, but I don't want the user to be able to unhide it except for programmatically essentially

shape.visible = xlVeryHidden

It is possible to do this programmatically using PowerPoint events to detect the selection of your 'marked' shape, hide it and then unselect it. I have used this mechanism in several of my PowerPoint add-in products before and it works very well. It requires the following elements:

  1. VBA code in class module for PowerPoint app events
  2. VBA code in standard module
  3. Initialisation of app events via the ribbon onLoad callback
  4. Identification mechanism for the shape(s) you want to hide. Tags work best but you could also use the simpler .Name property
  5. Use of Win API timer to trigger a check for shapes unhidden using the Selection Pane
  6. Solution code contained within either a macro-enabled PowerPoint file (.pptm, .potm, .ppsm) or a PowerPoint application add-in (.ppam)

Here is tested code: (not production quality, for example, doesn't handle non-slide views)

In a class module called "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

In a standard module called "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

In a standard module called "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

And finally, add this ribbon XML to the macro-enabled pptm/ppam/ppsm/potm file:

<customUI onLoad="OnLoadRibbon" xmlns="http://schemas.microsoft.com/office/2006/01/customui"/>

Now, if you open the macro-enabled file and add a shape to any slide with a name "VeryHidden" you shouldn't be able to unhide it via the PowerPoint UI. Of course, tags should be used instead of names but this is just to prove the concept.

There is no such equivalent in PowerPoint. Any hidden shape can be made visible from the selection pane.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM