はじめに
前回に引き続いて、
 
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 ClassIMessageFilterインターフェイスは、
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 FunctionOfficeアプリがすぐに要求した処理を行えない場合、
通常はダイアログを表示して、
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 FunctionMessagePending関数は、
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 FunctionAddPictureメソッド内の、
' LiveConnectClient の更新
Dim authClient = New LiveAuthClient(ThisAddIn.ClientId)
Dim newSession = authClient.RefleshSession(Me.LiveConnectClient.Session)
Me.LiveConnectClient = New LiveConnectClient(newSession)ここでは単純に必ずアクセストークンを更新するようにしています。LiveConnectSessionオブジェクトは、
おわりに
SkyDriveと連携したPowerPointアドインの開発は以上です。いかがでしたか。これまでの連載内容の一区切りということで、