最近ノートPCなど高解像度化(4K)が進んできています。 Surface Pro 4 や Surface Book も 267 ppi とかなり細かいですよね。
テキストのサイズを標準の 100％ から 150％ や 200％ にすればよいのですが、ストア アプリの表示はは問題ない(フォントが綺麗になるスマートフォンのアプリのイメージ)のですが、デスクトップアプリの場合は、ボタンが画面からはみ出たりして使い勝手に影響する場合があります。
その関係で 100％ のまま使うという事も多いのですが、そうなるとフォントがかなり小さくなるので、フォントを大きくしたりアプリに Zoom 機能がある場合にはそれで大きくして見るという事を行うと思います。
そういった状況の中、Outlook 2016 で Zoom を150% 固定にしたくなったのですが、そういった機能がありません。
調べてみると、Outlook 2010 ぐらいから試行錯誤している人たちがいる事がわかりました。
2013 までは記述があり、これまでの方法でメールを開いた時には 150％ になったのですが、エクスプローラーの表示を Conversation でまとめる表示にしている場合には、次のコードが実行できずエラーになります。
Application.ActiveExplorer.RemoveFromSelection (Msg)
Application.ActiveExplorer.AddToSelection (Msg)
そのため、プレビュー画面を 150％ にできませんでした。
この部分を変更しないとプレビュー画面は 100％ のままになるので、API のタイマーを利用することで、時差を利用して設定し、150％ にする事ができましたので、その方法を書いておきます。
なお、64bit 版 Outlook 2016 でのみ確認しておりますので、あらかじめご了承お願いします。
事前設定
上記スレッドにあるように、
- マクロのセキュリティ設定の変更
- リファレンスから Microsoft Word 16.0 Object Library にチェックを入れる
- Redemption drivers の入手とリファレンスから Redemption Outlook and MAPI COM Library にチェックを入れる
次の 2 か所のコードの MsgZoom の値を変更し、200% や 125% などちょうどいい大きさに設定してください
モジュールを追加し、次のコードを入力
Option Explicit
Private sExplorer As Object
Private Document As Object
Const MsgZoom = 150
Private lngTimerID As Long
Private BlnTimer As Boolean
Private Declare PtrSafe Function SetTimer Lib “user32” (ByVal hwnd As Long, ByVal nIDEvent As Long, ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As Long
Private Declare PtrSafe Function KillTimer Lib “user32” (ByVal hwnd As Long, ByVal nDEvent As Long) As Long
Public Sub TimerProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal idEvent As Long, ByVal dwTime As Long)
On Error Resume Next
sExplorer.Item = Application.ActiveExplorer
Set Document = sExplorer.ReadingPane.WordEditor
Document.Windows.Item(1).View.Zoom.Percentage = MsgZoom
DisableTimer
End Sub
Public Sub EnableTimer()
Set sExplorer = CreateObject(“Redemption.SafeExplorer”)
lngTimerID = SetTimer(0, 0, 1000, AddressOf TimerProc)
BlnTimer = True
End Sub
Public Sub DisableTimer()
lngTimerID = KillTimer(0, lngTimerID)
BlnTimer = False
End Sub
Public Sub SetExplorerObject()
Set sExplorer = CreateObject(“Redemption.SafeExplorer”)
End Sub
ThisOutlookSession に次のコードを入力
Option Explicit
Private WithEvents objInspectors As Outlook.Inspectors
Private WithEvents objOpenInspector As Outlook.Inspector
Private WithEvents objMailItem As Outlook.MailItem
Private WithEvents myOlExp As Outlook.Explorer
Private WithEvents myOlItems As Outlook.Items
Const MsgZoom = 150
Private Sub Application_Startup()
Set objInspectors = Application.Inspectors
Set myOlExp = Application.ActiveExplorer
Set myOlItems = Application.GetNamespace(“MAPI”) _
.GetDefaultFolder(olFolderDeletedItems) _
.Items
SetExplorerObject
End Sub
Private Sub Application_Quit()
Set objOpenInspector = Nothing
Set objInspectors = Nothing
Set objMailItem = Nothing
End Sub
Private Sub objInspectors_NewInspector(ByVal Inspector As Inspector)
If Inspector.CurrentItem.Class = olMail Then
Set objMailItem = Inspector.CurrentItem
Set objOpenInspector = Inspector
End If
End Sub
Private Sub objOpenInspector_Close()
Set objMailItem = Nothing
End Sub
Private Sub objOpenInspector_Activate()
Dim wdDoc As Word.Document
Set wdDoc = objOpenInspector.WordEditor
wdDoc.Windows(1).Panes(1).View.Zoom.Percentage = MsgZoom
End Sub
Private Sub myOlExp_SelectionChange()
EnableTimer
End Sub
Private Sub myOlItems_ItemAdd(ByVal Item As Object)
If TypeOf Item Is MailItem Then
EnableTimer
End If
End Sub
P.S
ちなみにシステムフォンの大きさの変更には、次の 「Meiryo UI も大っきらい!!」を使わさせていただきました。
http://homepage3.nifty.com/Tatsu_syo/MySoft/index.html#noMeiryoUI
Yukinori's Blog 