'------------------------------------------------------------
'			Export2PowerPoint.vbs
'  This script exports the current album as a Microsoft
'  PowerPoint presentation.
'------------------------------------------------------------

Option Explicit

app.ClearTrace

'Dim app As MyAlbum.Application
'Dim alb As MyAlbum.Album, pic As MyAlbum.MyPicture
'Set app = CreateObject("MyAlbum.Application")
'app.Visible = True
'Set alb = app.LoadAlbum("C:\Program Files\MyAlbum\Argentine2001-2.alb")

dim alb, pic, nb, i
set alb = app.GetCurrentAlbum()
nb = alb.nbVisiblePicture
' The titles of the slides will be constructed using this display string
const sSlideTitle = "%C7 - %C1 %C2"

'Dim ppApp As PowerPoint.Application, ppt As PowerPoint.Presentation, shT As PowerPoint.Shape
Dim ppApp, ppt, shT
Set ppApp = CreateObject("PowerPoint.Application")
ppApp.Visible = True

Const ppLayoutTitleOnly = 11
Const ppAlignCenter = 2
    
Set ppt = ppApp.Presentations.Add
ppt.SlideMaster.Background.Fill.Visible = True
ppt.SlideMaster.Background.Fill.ForeColor.RGB = RGB(64, 64, 64)
Set shT = ppt.SlideMaster.Shapes(1)
shT.TextFrame.TextRange.Font.Name = "Times New Roman"
shT.TextFrame.TextRange.Font.Size = 20
shT.TextFrame.TextRange.Font.Color.RGB = RGB(255, 0, 0)
shT.Top = 5
shT.Height = 30
    
Dim sl 'As PowerPoint.Slide
Dim shP 'As PowerPoint.Shape
Dim w, h, wP, hP
w = ppt.PageSetup.SlideWidth
h = ppt.PageSetup.SlideHeight
For i = 0 To nb-1
  Set pic = alb.GetVisiblePicture(i)
  Set sl = ppt.Slides.Add(ppt.Slides.Count + 1, ppLayoutTitleOnly)
  ppApp.ActiveWindow.View.GotoSlide ppt.Slides.Count
  'sl.Select
  Set shT = sl.Shapes(1)
  shT.TextFrame.TextRange.Text = alb.ExpandMacro(pic, sSlideTitle)
  'shT.TextFrame.TextRange.Font.Color.SchemeColor = ppTitle
  shT.Left = (w - shT.Width) / 2
  shT.TextFrame.TextRange.ParagraphFormat.Alignment = ppAlignCenter
  Set shP = sl.Shapes.AddPicture( alb.ExpandMacro(pic, "%RP"), False, True, 10, shT.Top + shT.Height, -1, -1 )
  shP.LockAspectRatio = False
  wP = w - 2 * 10
  hP = h - shT.Top - shT.Height - 10
  If pic.w / pic.h > wP / hP Then
    shP.Width = wP
    shP.Height = pic.h * shP.Width / pic.w
    shP.Top = shT.Top + shT.Height + (hP - shP.Height) / 2
  Else
    shP.Height = hP
    shP.Width = pic.w * shP.Height / pic.h
    shP.Left = 10 + (wP - shP.Width) / 2
  End If
Next