powerpointに貼り付けた複数個の図をきれいに並べるマクロ

使用法

①図を、並べたい順番に選択する。
　現状 4,6,8枚のみ対応

②マクロ実行する

テンプレートによってスライド上部のタイトル部分の大きさが
異なりますが、その場合は yoffset の値を適宜調整ください。

しかしoffice2010でマクロ記録機能もなくなりマクロの書き方も
どこを調べればいいのか非常にわかりにくい。



Sub MultiImageTile()


    SlideHeight = ActivePresentation.PageSetup.SlideHeight
    SlideWidth = ActivePresentation.PageSetup.SlideWidth
    xoffset = 2
    yoffset = 70
    captionheight = 50

   
    imagenum = ActiveWindow.Selection.ShapeRange.Count
   
    If imagenum = 6 Then
        Nrow = 2
        Ncolumn = 3
    ElseIf imagenum = 8 Then
        Nrow = 2
        Ncolumn = 4
    ElseIf imagenum = 4 Then
        Nrow = 2
        Ncolumn = 2
    End If
   
       
    imagewidth = (SlideWidth - xoffset) / Ncolumn - xoffset
    imageheight = (SlideHeight - yoffset) / Nrow - captionheight
   
 
    For y = 1 To Nrow
        For x = 1 To Ncolumn
           
            imagetop = yoffset + (y - 1) * (imageheight + captionheight)
            imageleft = xoffset + (x - 1) * (imagewidth + xoffset)
'           ActiveWindow.Selection.ShapeRange.ScaleWidth 0.48, msoTrue

            With ActiveWindow.Selection.ShapeRange((y - 1) * Ncolumn + x)
'               .Fill.Transparency = 0#
                .LockAspectRatio = msoTrue
                .Top = imagetop
                .Left = imageleft
'               .Width = imagewidth
'               .Height = imageheight
            End With
               
            If imagewidth / ActiveWindow.Selection.ShapeRange((y - 1) * Ncolumn + x).Width < imageheight / ActiveWindow.Selection.ShapeRange((y - 1) * Ncolumn + x).Height Then
                ActiveWindow.Selection.ShapeRange((y - 1) * Ncolumn + x).Width = imagewidth
                captiontop = imagetop + ActiveWindow.Selection.ShapeRange((y - 1) * Ncolumn + x).Height
            Else
                ActiveWindow.Selection.ShapeRange((y - 1) * Ncolumn + x).Height = imageheight
                captiontop = imagetop + imageheight
            End If
           

     '      activewindow.shapes.addtextbox(1,imageleft,imagetop+imageheight,imagewidth,captionheight)
            Set captiontext = ActivePresentation.Slides(ActiveWindow.Selection.SlideRange.SlideIndex).Shapes.AddTextbox(1, imageleft, captiontop, imagewidth, captionheight)
            With captiontext
                .TextFrame.TextRange.Text = "aa"
                .TextFrame.TextRange.ParagraphFormat.Alignment = msoAnchorCenter
                .TextFrame.TextRange.Font.Size = 12
'               .TextFrame.HorizontalAnchor = msoAnchorCenter
            End With
               


               
                   
     '      Captiontext.TextFrame.HorizontalAlignment = 2
               
        Next
    Next
       
End Sub

windows XP mode が遅い

下記ページ方法２で改善した。

http://support.microsoft.com/kb/978209/ja

方法 2 : Windows XP Mode や Virtual PC の Idle thread を有効化する

以下の手順で、ゲスト OS が Idle になった場合に Idle Thread を実行して、連続した作業を継続させてください。

注 : 複数のユーザーでコンピュータを共有する場合は、それぞれのユーザーに対して設定変更をする必要があります。

1. Windows XP Mode または Virtual PC を停止します。
2. 以下のコマンドを実行して、Options.xml ファイルを開きます。
   
   notepad "%LocalAppData%\Microsoft\Windows Virtual PC\Options.xml"
3. <virtual_machines> セクションに以下のキーを追加入力します。
   
   <enable_idle_thread type="boolean">true</enable_idle_thread>
4. Options.xml ファイルを保存し、Virtual PC を再起動します。