PowerPointで時計表示

質問

やりたいことは、PowerPointのスライドショーでリアルタイムで変る時計を表示したいのですが。
PowerPointのVBでは、タイマーコントロールがないし、実行開始イベントが何を使えばいいのかわかりません。
どなたか、回答宜しくお願いします。

回答No.3

TAGOSAKU7

サンプルです。

先ほどの発言に間違いがあります。テキストボックスを透過させようとしましたが、WIN2000限定仕様のようです。

処理はMain関数で実行するだけです。
カッコ悪いですが、現在時間を表示します。

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function IsWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function GetDesktopWindow Lib "user32" () As Long
Private Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Private Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String) As Long

Private Const WM_SETTEXT = &HC

Private Const WS_VISIBLE = &H10000000
Private Const WS_CHILD = &H40000000
Private Const WS_BORDER = &H800000

Private Const HWND_TOPMOST = (-1)
Private Const SWP_NOSIZE = &H1&
Private Const SWP_NOMOVE = &H2&
Private Const SWP_SHOWWINDOW = &H40&

Sub Main()
　　'とりあえず実行
　　ActivePresentation.SlideShowSettings.Run

　　'時計開始
　　Call DESP_CLOCK
End Sub

Sub DESP_CLOCK()
　　Dim OwnerWnd　　As Long
　　Dim lngWinStyle As Long
　　Dim labelWnd　　As Long
　　Dim strWork　　 As String
　　Dim strMem　　　As String

　　'プレゼンウィンドウのハンドルを得る
　　OwnerWnd = FindWindow("screenClass", vbNullString)

　　'ハンドルを得ることができないとき終了
　　If OwnerWnd = 0 Then
　　　　MsgBox "プレゼンウインドウが見つからない"
　　　　Exit Sub
　　End If

　　'ウィンドウスタイルを指定して、STATICオブジェクトを作成
　　lngWinStyle = WS_CHILD Or WS_VISIBLE
　　labelWnd = CreateWindowEx(0, "edit", Now, lngWinStyle, _
　　　　　　　　　　 20, 20, 150, 20, _
　　　　　　　　　　 GetDesktopWindow, 0, 0, ByVal CLng(0))

　　'作成したオブジェクトを最前面固定
　　Call SetWindowPos(labelWnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE Or SWP_SHOWWINDOW)

　　'スライドが閉じるまでループ
　　Do Until IsWindow(OwnerWnd) = 0
　　　　'時刻の更新
　　　　strWork = Now & vbNullChar
　　　　If strMem <> strWork Then
　　　　　　Call SetWindowText(labelWnd, strWork)
　　　　　　strMem = strWork
　　　　End If
　　　　DoEvents
　　Loop

　　' ウィンドウを破棄
　　Call DestroyWindow(labelWnd)

End Sub