簡體   English   中英

Xlveryhidden的VBA Power Point等效項

[英]VBA Power Point equivilant of xlveryhidden

Power Point 2016

我想隱藏一個形狀,但我不希望用戶能夠以編程方式取消隱藏它

shape.visible = xlVeryHidden

可以使用PowerPoint事件以編程方式執行此操作,以檢測對“標記”形狀的選擇,將其隱藏然后取消選擇。 之前,我在一些PowerPoint外接程序產品中都使用過這種機制,並且效果很好。 它需要以下元素:

  1. PowerPoint應用程序事件的類模塊中的VBA代碼
  2. 標准模塊中的VBA代碼
  3. 通過功能區onLoad回調初始化應用程序事件
  4. 要隱藏的形狀的識別機制。 標簽效果最好,但您也可以使用更簡單的.Name屬性
  5. 使用Win API計時器觸發對使用選擇窗格未隱藏的形狀的檢查
  6. 啟用宏的PowerPoint文件(.pptm,.potm,.ppsm)或PowerPoint應用程序加載項(.ppam)中包含的解決方案代碼

這是經過測試的代碼:(例如,不是生產質量,就不能處理非幻燈片視圖)

在名為“ 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中沒有這樣的等效項。 可以從選擇窗格中看到任何隱藏的形狀。

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM