使用法
①図を、並べたい順番に選択する。
現状 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
0 件のコメント:
コメントを投稿