En el artículo anterior hice una especie de gestor de fotos con excel. De momento sigue estando en fase preliminar pero cuando este terminado tendré que dotarlo de una manera sencilla de, además de tener una relación de fotos, un elemento que me permita ver las fotos seleccionadas. En la versión preliminar el libro excel da un código html que hay que llevar a un fichero de texto (html), ejecutarlo y, con un poco de suerte, ver las fotos. Una de las posibilidades que permiten ver las fotos seleccionadas es incluirlas automáticamente en una presentación Power Point, desde el gestor de fotos excel.
Trabajos preliminares, para empezar a usar códigos un poco, no mucho, mas complejos.
En Power point:
- Por un lado, necesitamos saber el código vbasic de Power Point que nos permita incluir, en este caso fotos, objetos en una presentación.
- Abro una presentación, busco la grabadora de macros, la activo, realizo manualmente la tarea deseada.
- Añado una diapositiva. Añado una foto. Añado un cuadro de texto.
- Detenemos la grabación de la macro. Vemos el código escrito por la grabadora de macros.
- Hemos obtenido un código que nos facilitará en trabajo de escribir nuestro código.
En Excel:
- Para manejar PP desde el vbasic de excel necesitamos incluir la librería correspondiente.
- Abrimos el libro excel correspondiente y con Alt+F11 vamos a los módulos vbasic.
- Con el menú Herramientas->Referencias busco y añado esa librería, en este caso "Microsoft Power Point 15.0 Object Library".
- En uno de los módulos creamos una macro que incluya nuestro código.
- En esa macro incluimos el objeto Power Point con Set ApliPP = New PowerPoint.Application.
- Añadimos una presentación con Set PresenPP = ApliPP.Presentations.Add
- Buscamos en la macro grabada por la grabadora de macros la manera de añadir una hoja. La adaptamos a nuestro código, y queda .Slides.Add(Index:=I, Layout:=ppLayoutBlank).Select
- Buscamos, en la macro grabada, como añadir una imagen a la hoja.
- Adaptamos esa instrucción a nuestro código. La instrucción resultante es
- ApliPP.ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=Nom, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=40, Top:=30, Width:=640, Height:=480).Select
Con el siguiente código vbasic podemos importar todas las fotos de un directorio de nuestro PC a una presentación PowerPoint desde nuestro libro Excel.
Sub PresPower()
Dim ApliPP As PowerPoint.Application
Dim PresenPP As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Hoja
Dim Nom As String
Dim H
Set ApliPP = New PowerPoint.Application
ApliPP.Visible = True
ApliPP.Activate
Set PresenPP = ApliPP.Presentations.Add
With PresenPP
'*********** Esta parte no es necesaria, la arrastro de otra versión
'*********** Elimina todas las diapos. de una presentación
For Each Hoja In .Slides
Hoja.Delete
Next
'**********************
I = 1
x = Dir("C:\DiscoWindowsXP\Fotos\20131010Duraton\*.JPG")
While x <> ""
Nom = "C:\DiscoWindowsXP\Fotos\20131010Duraton\" & x
' MsgBox Nom
.Slides.Add(Index:=I, Layout:=ppLayoutBlank).Select
Set H = PresenPP.Slides(I)
'On Error Resume Next
ApliPP.ActiveWindow.Selection.SlideRange.Shapes.AddPicture(FileName:=Nom, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=40, Top:=30, Width:=640, Height:=480).Select
On Error GoTo 0
I = I + 1
x = Dir()
Wend
End With
End Sub
Este otro código, un poco mas completo, recorre una hoja excel con una relación de fotos y las añade a una presentación PowerPoint, añadiendo, además, un cuadro de texto a cada foto.
Sub PPower()
Dim ApliPP As PowerPoint.Application
Dim PresenPP As PowerPoint.Presentation
Dim Diapo As PowerPoint.Slide
Dim Hoja
Dim Nom As String
Dim H
Dim DAnt, D, A As String
DAnt = ""
Set ApliPP = New PowerPoint.Application '
ApliPP.Visible = True
ApliPP.Activate
Set H = ActiveWorkbook.Sheets("Buscar")
Set PresenPP = ApliPP.Presentations.Add
With PresenPP
For Each Hoja In .Slides
Hoja.Delete
Next
End With
I = 1
j = 2
D = H.Range("d" & j).Value
DAnt = D
Nom = H.Range("d" & j) & H.Range("e" & j)
A = H.Range("h" & j).Value
While Nom <> ""
D = H.Range("d" & j).Value
A = H.Range("h" & j).Value
If (D <> DAnt And Nom <> "") Or I > 100 Then
Set PresenPP = ApliPP.Presentations.Add
I = 1
DAnt = D
End If
PresenPP.Slides.Add(Index:=I, Layout:=ppLayoutBlank).Select
'On Error Resume Next
ApliPP.ActiveWindow.Selection.SlideRange.Shapes.AddPicture(Filename:=Nom, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=40, Top:=30).Select ' Width:=640, Height:=480).Select
er = Error()
'ApliPP.ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 400, 900, 30).Select
'ApliPP.ActiveWindow.Selection.TextRange.Text = Nom & " " & er
ApliPP.ActiveWindow.Selection.SlideRange.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 500, 900, 30).Select
ApliPP.ActiveWindow.Selection.TextRange.Text = A
On Error GoTo 0
I = I + 1
j = j + 1
Nom = H.Range("d" & j) & H.Range("e" & j)
DAnt = D
Wend
'End With
End Sub
