概要
PowerPointのスライド1枚目をWindowsの壁紙に設定するVBAです。
VBAを実行することでWindowsAPIを呼び出し、壁紙の設定を行います。
強味・利点
- PowerPointに慣れているユーザーはデザインしやすい
- デザイン変更→反映がスムーズにできるため、文字サイズや図形配置等の調整がしやすい
- 私用・会社用どちらにも標準的に搭載されているソフトウェアで壁紙のデザイン・設定ができるため、新たなソフトウェアの導入が不要
コード
slide1Setting
'条件コンパイル。VBA7か否かは、Officeのverによって異なる。
'SystemParametersInfoはWindowsの設定を変更するAPIで、user32.dllに入っている
#If VBA7 Then
Private Declare PtrSafe Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
ByVal uAction As Long, _
ByVal uParam As Long, _
ByVal lpvParam As String, _
ByVal fuWinIni As Long) As Long
#Else
Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" ( _
ByVal uAction As Long, _
ByVal uParam As Long, _
ByVal lpvParam As String, _
ByVal fuWinIni As Long) As Long
#End If
'上から壁紙変更、設定保存、Windowsへ通知
Const SPI_SETDESKWALLPAPER As Long = 20
Const SPIF_UPDATEINIFILE As Long = 1
Const SPIF_SENDCHANGE As Long = 2
Sub SetSlide1AsWallpaper()
Dim imgFile As String
Dim ret As Long
imgFile = Environ("TEMP") & "\ppt_wallpaper.png"
' スライド1を画像保存。3840は幅、2160は高さで好きな値に変更可能
ActivePresentation.Slides(1).Export _
imgFile, _
"PNG", _
3840, _
2160
' 壁紙設定。第4引数は保存と通知のbit演算。01と10のorで11となり設定と通知両方がOnになる。
ret = SystemParametersInfo( _
SPI_SETDESKWALLPAPER, _
0, _
imgFile, _
SPIF_UPDATEINIFILE Or SPIF_SENDCHANGE)
If ret <> 0 Then
MsgBox "壁紙を変更しました。"
Else
MsgBox "壁紙変更に失敗しました。"
End If
End Sub
使い方
VBAの設定方法はこちらの記事を参考にしてください。
https://qiita.com/mamomi64/items/6cb756f900e10de121ff
リボンの開発→マクロ から実行する方法と、図形をクリックで実行する方法の2つがあります。
後者は、図形を選択した状態でリボンの挿入→動作（★みたいなマーク）→マクロの実行でマクロを設定すればクリックで実行できるようになります。ただし、クリックして実行できるのはスライドショーの時のみです。実行のために都度スライドショーモードにする必要があります。
使用例
画像や図形を好みに合わせて配置できます。
個人的にはメモを載せたり、フォルダ・ファイルを置く場所の枠を作れるところが良いと感じました。
最寄り駅の時刻表を貼っても良いかもしれません。
【スライド1のデザイン】
【実際の壁紙】
※サンゴと馬の画像は以下サイトのものを使ってます。
フリー素材.com：https://www.free-materials.com/
所感
Power Pointを使って何か面白いことができなかと思い生成AIに聞いたところ実現できました。壁紙のデザイン＆設定がしやすくなったので、結構気に入ってます。