
macro para guardar como
Publicado por Emiliano (3 intervenciones) el 14/06/2017 23:11:57
Hola buenas tardes
Esperando alguien me pueda ayudar
tengo esta macro que modifica el tamaño de una imagen que abarca toda la diapositiva, la ajusta a ella
y detecta cuantas diapositivas ay en la presentacion y cumple con un ciclo de repeticion para todas las diapositivas
Pero ahora solo necesito guardar cada diapositiva como jpg y eso ya lo tengo solo que necesito que al momento de que la macro valla a guardar las imagenes quiero que me abra la vantana de guardar como para cada vez que ejecute la macro yo pueda guardarlas en distintas carpetas
Espero alguien me pueda apoyar
Esperando alguien me pueda ayudar
tengo esta macro que modifica el tamaño de una imagen que abarca toda la diapositiva, la ajusta a ella
y detecta cuantas diapositivas ay en la presentacion y cumple con un ciclo de repeticion para todas las diapositivas
Pero ahora solo necesito guardar cada diapositiva como jpg y eso ya lo tengo solo que necesito que al momento de que la macro valla a guardar las imagenes quiero que me abra la vantana de guardar como para cada vez que ejecute la macro yo pueda guardarlas en distintas carpetas
Espero alguien me pueda apoyar
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Sub conmanejadordeerrores()
Dim i As Integer
'en caso de encontrar un error sigue ejecutando la macro
On Error GoTo Salir
For i = 1 To 50
'modificaremos el tamaño de la imagen
With ActivePresentation.Slides(i).Shapes(1)
.Fill.Transparency = 0
.LockAspectRatio = msoFalse
.Height = 500
.Width = 900
.IncrementLeft 175 * IIf((i - 1) Mod 2, -1, 1)
.IncrementTop 100 * IIf(i > 2, -1, 1)
.Left = 30
.Top = 20
End With
Next i
Salir:
i = i - 1
MsgBox "SE FINALIZARON LAS " & i & " DIAPOSITIVAS"
End Sub
Sub Save_PowerPoint_Slide_as_Images()
'*convierte diapositiva por diapositiva en imagen jpg y la guarda
Dim sImagePath As String
Dim sImageName As String
Dim oSlide As Slide '* Objeto de diapositiva
Dim lScaleWidth As Long '* Ancho de la escala
Dim lScaleHeight As Long '* Altura * Escala
On Error GoTo Err_ImageSave
sImagePath = "C:\Users\Emiliano\Desktop\imagenes\"
For Each oSlide In ActivePresentation.Slides
sImageName = oSlide.Name & ".jpg"
oSlide.Export sImagePath & sImageName, "JPG"
Next oSlide
Err_ImageSave:
If Err <> 0 Then
MsgBox Err.Description
End If
End Sub
Valora esta pregunta


0