Hola.
El problema que se 'salen' es por que normalmente las 'diapositivas' de powerpoint son apaisadas.
Una solución que se adjunta pasa por disminuirlas de tamaño ( 0.6). Cabe la posibilidad de pasarlas al 100% a A4 apaisado.
Public Sub pasapowerawordminiatura()
Dim mipower As Object 'New PowerPoint.Application
Dim mipresentacion As Object 'PowerPoint.Presentation
Dim midiapositiva As Object 'PowerPoint.Slide
Set mipower = CreateObject("powerpoint.application")
Dim nn As Long
Dim numdiapo As Long
Dim midoc As Document
Dim mifichero As String
mifichero = ActiveDocument.Path & "\NOMBREPRESENTACION.pptx"
Set mipresentacion = mipower.Presentations.Open(mifichero)
Set midoc = Application.Documents.Add
midoc.Activate
numdiapo = mipresentacion.Slides.Count
mipower.Visible = True
For n = numdiapo To 1 Step -1
Set midiapositiva = mipresentacion.Slides(n)
midiapositiva.Select
midiapositiva.Shapes.SelectAll
mipower.ActiveWindow.Selection.Copy
Selection.HomeKey Unit:=wdStory
Selection.InsertParagraphBefore
Selection.InsertParagraphBefore
Selection.HomeKey Unit:=wdStory
Selection.Paste
Selection.ShapeRange.Group.Select
Selection.ShapeRange.ScaleWidth 0.6, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.ScaleHeight 0.6, msoFalse, msoScaleFromTopLeft
Selection.ShapeRange.Left = Application.CentimetersToPoints(0.2)
Selection.ShapeRange.WrapFormat.AllowOverlap = False
Selection.ShapeRange.WrapFormat.Side = wdWrapBoth
Next n
mipresentacion.Close
mipower.Quit
Set mipresentacion = Nothing
Set mipower = Nothing
midoc.Application.WindowState = wdWindowStateMaximize
End Sub
En un principio, al disminuir el tamaño las imágenes se quedan igual, pero en los cuadros de texto puede ocurrir que lo escrito no se vea totalmente( habría que cambiar el tamño de la letra)
Espero que se acerque a la solución pedida
Ya dices.
Un saludo a todos
Tweet
Pegar contenido portapapeles desde vba a word
Opciones del Tema
