PowerPointで時計表示

サンプルです。 先ほどの発言に間違いがあります。テキストボックスを透過させようとしましたが、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

うーむ、うーむ、うーむ、 そうですかー、、、 そこまでのカスタマイズを求めるのであれば、パワポを使用しないで、HTMLに出力してしまってはいかがですか？ JAVASやVBSを使用することで回避できそうな気がします。 どうしてもパワポにこだわりますか？ もしそうなら、一応反則技は存在しそうです。処理としては・・・ テキストボックスをAPIで作成し、透過形式にスタイルを変更して、テキストボックスの親ハンドルををパワポに設定します。 スライドのページが変わっても親ハンドルとなるパワポは、存在しつづけるので、テキストボックスは常に最前面に居続けます。 欠点としては環境に左右します。もし二つ以上のプレゼンが実行されているとき、どのプレゼンを親とするかがわかりません。 プレゼン中はハンドルが変わらないことは確認しましたが、実際に実現して検証を行わないと、正確なことは言えないので、自信は５０％です。

パワポのVBAって初経験です。 プレゼン自体にイベント通知が発生しないようですね。 ですので、開始／終了時にフラグを立てて、コードから実行する必要があるようです。 詳細としては、 各スライドに時計表示用のラベルを用意する必要があります。 Mainモジュールから実行して起動してください。 注意事項としては、ESCキーなどで終了するのではなく、各スライドに終了ボタンを用意するか、あるいは各スライドの時計表示されるラベルのクリックイベントなどで、終了フラグを立てる必要があります。参考コードではCloseCommand関数を呼ぶと、コードが抜ける仕組みになってます。 これ以外の方法は、調べたところわかりませんでした。 うーむ、パワポのVBA・・・扱いづらい・・・ Private flgEnd　As Byte Sub Main() 　　'各ラベルを透化 　　Slide1.Label1.BackStyle = 0 　　Slide2.Label1.BackStyle = 0 　　 　　'とりあえず実行 　　ActivePresentation.SlideShowSettings.Run 　　 　　'時計開始 　　Call DESP_CLOCK End Sub Sub DESP_CLOCK() 　　flgEnd = 0 　　Do While flgEnd = 0 　　　　Slide1.Label1.Caption = Now 　　　　Slide2.Label1.Caption = Now 　　　　DoEvents 　　Loop End Sub Public Sub CloseCommand() 　　flgEnd = 1 End Sub