はじめに
前回に引き続いて、

Officeアドインで非同期処理
前回でほとんどの準備を行いましたが、
ネットワークアクセスなど時間のかかる処理は、
IMessageFilterの実装
まず、
Imports System.Runtime.InteropServices
Imports System.Runtime.CompilerServices
<ComImport, ComConversionLoss, InterfaceType(1S), Guid("00000016-0000-0000-C000-000000000046")>
Public Interface IMessageFilter
<PreserveSig, MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function HandleInComingCall(dwCallType As UInteger, htaskCaller As IntPtr, dwTickCount As UInteger, lpInterfaceInfo As IntPtr) As Integer
<PreserveSig, MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function RetryRejectedCall(htaskCallee As IntPtr, dwTickCount As UInteger, dwRejectType As UInteger) As Integer
<PreserveSig, MethodImpl(MethodImplOptions.InternalCall, MethodCodeType:=MethodCodeType.Runtime)> _
Function MessagePending(htaskCallee As IntPtr, dwTickCount As UInteger, dwPendingType As UInteger) As Integer
End Interface
このインターフェイスをThisAddInクラスで実装します。次のようにImplementsステートメントでIMessageFilterインターフェイスの実装を指定します。
Public Class ThisAddIn
Implements IMessageFilter
'(省略)
Public Function HandleInComingCall(dwCallType As UInteger, htaskCaller As IntPtr, dwTickCount As UInteger, lpInterfaceInfo As IntPtr) As Integer Implements IMessageFilter.HandleInComingCall
End Function
Public Function MessagePending(htaskCallee As IntPtr, dwTickCount As UInteger, dwPendingType As UInteger) As Integer Implements IMessageFilter.MessagePending
End Function
Public Function RetryRejectedCall(htaskCallee As IntPtr, dwTickCount As UInteger, dwRejectType As UInteger) As Integer Implements IMessageFilter.RetryRejectedCall
End Function
End Class
IMessageFilterインターフェイスは、
Private Const SERVERCALL_ISHANDLED As Integer = 0
Public Function HandleInComingCall(dwCallType As UInteger, htaskCaller As IntPtr, dwTickCount As UInteger, lpInterfaceInfo As IntPtr) As Integer Implements IMessageFilter.HandleInComingCall
Return SERVERCALL_ISHANDLED
End Function
Officeアプリがすぐに要求した処理を行えない場合、
通常はダイアログを表示して、
Private Const SERVERCALL_RETRYLATER As Integer = 2
Public Function RetryRejectedCall(htaskCallee As IntPtr, dwTickCount As UInteger, dwRejectType As UInteger) As Integer Implements IMessageFilter.RetryRejectedCall
If dwRejectType = SERVERCALL_RETRYLATER Then
Return 100
Else
Return -1
End If
End Function
MessagePending関数は、
Private Const PENDINGMSG_WAITDEFPROCESS As Integer = 2
Public Function MessagePending(htaskCallee As IntPtr, dwTickCount As UInteger, dwPendingType As UInteger) As Integer Implements IMessageFilter.MessagePending
Return PENDINGMSG_WAITDEFPROCESS
End Function
以上で、
MessageFilterの登録
IMessageFilterインターフェイスを実装しただけでは意味がありません。非同期処理を行うときに、
次のようにThisAddInクラスに定義を追加しましょう。
' (ファイル先頭に Imports System.Runtime.InteropServices も追加すること)
<DllImport("ole32.dll")>
Private Shared Function CoRegisterMessageFilter(lpMessageFilter As IMessageFilter, ByRef lplpMessageFilter As IMessageFilter) As Integer
End Function
続いて、
Private Sub GetUserInfo(session As LiveConnectSession)
Dim previousMessageFilter As IMessageFilter = Nothing
CoRegisterMessageFilter(Me, previousMessageFilter) ' 登録
Me.LiveConnectClient = New LiveConnectClient(session)
Globals.Ribbons.MainRibbon.SignInButton.Enabled = False
Try
' (ここの内容は前回と同じ)
Catch ex As Exception
' (例外は無視)
' 再度サインインできるようボタンを有効化
Globals.Ribbons.MainRibbon.SignInButton.Enabled = True
Finally
CoRegisterMessageFilter(Nothing, previousMessageFilter) ' 解除
End Try
End Sub
以上で、
マーカーの追加
それでは、
作成するアドインでは、
現在のスライドへ四角形のオートシェイプの追加は次のように記述できます。追加する位置と大きさは決め打ちにしています。
Dim w = Application.ActiveWindow
Dim slide = DirectCast(w.View.Slide, PowerPoint.Slide)
Dim shape = w.Presentation.Slides(slide.SlideIndex).Shapes.AddShape(Microsoft.Office.Core.MsoAutoShapeType.msoShapeRectangle, 0, 0, 100, 100)
アドイン側で、
Private Const TagName As String = "SampleAddInObject"
Sub AddMarker()
Try
Dim w = Application.ActiveWindow
Dim slide = DirectCast(w.View.Slide, PowerPoint.Slide)
' 既にあるマーカーを削除
For i = slide.Shapes.Count To 1 Step -1
Dim s = slide.Shapes(i)
If s.Tags.Item(TagName) = "Marker" Then
s.Delete()
End If
Next
Dim shape = w.Presentation.Slides(slide.SlideIndex).Shapes.AddShape(Microsoft.Office.Core.MsoAutoShapeType.msoShapeRectangle, 0, 0, 100, 100)
shape.Tags.Add(TagName, "Marker")
Catch ex As Exception
' (例外は無視)
End Try
End Sub
マーカーの追加ボタンがクリックされたとき、
ここまでを実行してみましょう

スライドショー時の処理
次は、
作成するアドインでは、
現在表示されているスライドの次のスライドにマーカーがあるかを確認し、
写真のダウンロードと表示は、
Private Sub Application_SlideShowNextSlide(Wn As Microsoft.Office.Interop.PowerPoint.SlideShowWindow) Handles Application.SlideShowNextSlide
If Wn.View.Slide.SlideIndex >= Wn.Presentation.Slides.Count Then
Exit Sub
End If
' 次のスライド
Dim slide = Wn.Presentation.Slides(Wn.View.Slide.SlideIndex + 1)
' スライドにマーカーがあるかチェック
Dim shape As PowerPoint.Shape = Nothing
For Each s As PowerPoint.Shape In slide.Shapes
If s.Tags.Item(TagName) = "Marker" Then
shape = s
Exit For
End If
Next
If shape Is Nothing Then
Exit Sub
End If
' マーカーがある場合、AddPicture メソッドをスレッドで処理する
Dim t = New Threading.Thread(AddressOf AddPicture)
t.SetApartmentState(Threading.ApartmentState.STA)
t.Start(New Tuple(Of PowerPoint.Slide, PowerPoint.Shape)(slide, shape))
End Sub
ただし、
Private Sub Application_SlideShowNextSlide(Wn As Microsoft.Office.Interop.PowerPoint.SlideShowWindow) Handles Application.SlideShowNextSlide
If Wn.View.Slide.SlideIndex >= Wn.Presentation.Slides.Count Then
Exit Sub
End If
' 次のスライド
Dim slide = Wn.Presentation.Slides(Wn.View.Slide.SlideIndex + 1)
' 以前にアドインで追加された写真を削除
For i = slide.Shapes.Count To 1 Step -1
Dim s = slide.Shapes(i)
If s.Tags.Item(TagName) = "InsertedPicture" Then
s.Delete()
End If
Next
If Me.LiveConnectClient Is Nothing Then
Exit Sub
End If
' スライドにマーカーがあるかチェック
Dim shape As PowerPoint.Shape = Nothing
For Each s As PowerPoint.Shape In slide.Shapes
If s.Tags.Item(TagName) = "Marker" Then
shape = s
Exit For
End If
Next
If shape Is Nothing Then
Exit Sub
End If
' マーカーがある場合、AddPicture メソッドをスレッドで処理する
Dim t = New Threading.Thread(AddressOf AddPicture)
t.SetApartmentState(Threading.ApartmentState.STA)
t.Start(New Tuple(Of PowerPoint.Slide, PowerPoint.Shape)(slide, shape))
End Sub
今回のアドインでは、
写真のダウンロード
SkyDriveから写真をダウンロードして、
Private Sub AddPicture(data As Tuple(Of PowerPoint.Slide, PowerPoint.Shape))
Dim previousMessageFilter As IMessageFilter = Nothing
CoRegisterMessageFilter(Me, previousMessageFilter)
Dim slide = data.Item1
Dim marker = data.Item2
Try
' (ここに写真のダウンロードとスライドに追加する処理を追記する)
Catch ex As Exception
' (例外は無視)
Finally
CoRegisterMessageFilter(Nothing, previousMessageFilter)
End Try
End Sub
さて、
- https://
apis. live. net/ v5. 0/ me/ skydrive/ files?access_ token=ACCESS_ TOKEN
また、
- https://
apis. live. net/ v5. 0/FOLDER_ ID /files?access_token=ACCESS_ TOKEN
指定したフォルダーから写真を取得してもいいのですが、
- https://
apis. live. net/ v5. 0/ me/ skydrive/ camera_ roll/ files?access_ token=ACCESS_ TOKEN
さらに、
- https://
apis. live. net/ v5. 0/ me/ skydrive/ camera_ roll/photos?access_ token=ACCESS_ TOKEN &limit=1&sort_by =updated&sort_order =descending
アドインでは上記のURLにアクセスするようにします。サーバーから受け取るデータは次のようなJSON形式のデータになります。この中から写真のダウンロードのためにsourceと、
{
"data": [
{
"id": "file.xxxxx",
"from": {
"name": "梓 中野",
"id": "xxxxx"
},
"name": "WP_001111.jpg",
"description": null,
"parent_id": "folder.xxxxx",
"size": 181761,
"comments_count": 0,
"comments_enabled": false,
"tags_count": 0,
"tags_enabled": true,
"is_embeddable": true,
"picture": "http://storage.live.com/xxxxx/WP_001111.jpg:Thumbnail/WP_001111.jpg",
"source": "http://storage.live.com/xxxxx/WP_001111.jpg:Default,Largest/WP_001111.jpg",
"upload_location": "https://apis.live.net/v5.0/file.xxxxx/content/",
"images": [
... 省略 ...
],
"link": "https://skydrive.live.com/redir.aspx?cid\xxxxx",
"when_taken": "2012-05-24T12:00:00+0000",
"height": 538,
"width": 717,
"type": "photo",
"location": {
"latitude": 35.2034,
"longitude": 136.2326
},
"shared_with": {
"access": "Just me"
},
"created_time": "2012-05-23T13:00:00+0000",
"updated_time": "2012-05-23T13:00:00+0000"
}
],
"paging": {
"next": "/me/skydrive/camera_roll/files?xxxxx"
}
}
写真のダウンロードまでをコードにします。LiveサービスにアクセスするLiveConnectClientクラスを用意していたので、
' SkyDrive から最新の写真1枚の情報を取得
Dim result = Me.LiveConnectClient.Get(
"me/skydrive/camera_roll/files?limit=1&sort_by=updated&sort_order=descending")
Dim o = JObject.Parse(result)
Dim src = o("data")(0)("source").ToString
Dim w = o("data")(0)("width").Value(Of Integer)()
Dim h = o("data")(0)("height").Value(Of Integer)()
' 写真のダウンロード
Dim client = New Net.WebClient
Dim file = System.IO.Path.GetTempFileName ' 一時的なファイル名を生成
client.DownloadFile(src, file)
特別に難しいところはないと思います。続いてダウンロードした写真をスライドに追加します。
' マーカーの範囲内に収まるように大きさを調節
Dim left, top, width, height As Single
If h * (marker.Width / w) <= marker.Height Then
width = marker.Width
height = h * (marker.Width / w)
left = marker.Left
top = marker.Top + (marker.Height - height) / 2
Else
width = w * (marker.Height / h)
height = marker.Height
left = marker.Left + (marker.Width - width) / 2
top = marker.Top
End If
' 写真をスライドに追加
Dim pic = slide.Shapes.AddPicture(file, Microsoft.Office.Core.MsoTriState.msoFalse, Microsoft.Office.Core.MsoTriState.msoCTrue, left, top, width, height)
pic.Tags.Add(TagName, "InsertedPicture")
pic.Left = left
pic.Top = top
pic.Width = width
pic.Height = height
pic.ZOrder(Microsoft.Office.Core.MsoZOrderCmd.msoBringForward) '最前面に表示
マーカーで示した範囲内に収まるように位置を計算し、
以上で、
動作の確認
ここまでで、
- サインインボタンからサインインします。
- 新しいプレゼンテーションに、
スライドを1枚追加します。 - 2枚目のスライドにマーカーを追加します
(図3)。

ここまでの動作は、

もちろん、
図でもわかるように、
サインアウト処理
少し残っている処理を書いていきましょう。サインアウトボタンをクリックしたときの処理は、
Sub SignOut()
Me.LiveConnectClient = Nothing
Globals.Ribbons.MainRibbon.SignInButton.Visible = True
Globals.Ribbons.MainRibbon.SignInButton.Enabled = True
Globals.Ribbons.MainRibbon.SignOutMenu.Visible = False
End Sub
アクセストークンの更新
先ほどの動作の確認では、
アクセストークンの更新には、
新しいアクセストークンの取得は、
- https://
oauth. live. com/ token?client_ id=CLIENT_ ID &grant_type=refresh_ token&refresh_ token=REFRESH_ TOKEN &redirect_uri=https:// oauth. live. com/ desktop
LiveAuthClientクラスに、
Function RefleshSession(session As LiveConnectSession) As LiveConnectSession
Dim uri = New Uri(String.Format("https://oauth.live.com/token?client_id={0}&grant_type=refresh_token&refresh_token={1}&redirect_uri={2}",
Me.ClientId, session.RefreshToken, Me.RedirectUri))
Dim client = New WebClient
Dim json = client.DownloadString(uri)
Dim o = JObject.Parse(json)
If o("error") IsNot Nothing Then
Return Nothing
End If
Dim newSession As New LiveConnectSession(
o("access_token").ToString(),
o("refresh_token").ToString(),
New DateTimeOffset(Now.ToUniversalTime).AddSeconds(o("expires_in").ToObject(Of Integer)),
o("scope").ToString.Split(" "c))
Return newSession
End Function
AddPictureメソッド内の、
' LiveConnectClient の更新
Dim authClient = New LiveAuthClient(ThisAddIn.ClientId)
Dim newSession = authClient.RefleshSession(Me.LiveConnectClient.Session)
Me.LiveConnectClient = New LiveConnectClient(newSession)
ここでは単純に必ずアクセストークンを更新するようにしています。LiveConnectSessionオブジェクトは、
おわりに
SkyDriveと連携したPowerPointアドインの開発は以上です。いかがでしたか。これまでの連載内容の一区切りということで、