Cuadrante de Servicio Parte 18 - Realización 4 Diapositiva en PowerPoint

 Vamos a continuar con el proyecto del Cuadrante de servicio.

Ahora vamos a diseñar la cuarta diapositiva, que en este caso, contendrá dos tablas y un gráfico.

Esta vez hemos elegido una diapositiva que contenga un Título y Gráficos, por lo que va a tener el layout igual a 8.

Por supuesto esta diapositiva tendrá nuestro logo.

Vamos a introducir nuestro código para la cuarta diapositiva:

Private Sub Diapositiva4()

    'tendremos dos tablas y un gráfico

    X = 4

    'vamos a crear una dispositiva con Titulo y Gráfico

    Set DiapoPP = PresentacionPP.slides.Add(Index:=X, Layout:=8)

     'Agregar un logo guardado

    CrearLogo

    'Agregamos Texto que se encuentra en una hoja, es el Titulo

    DiapoPP.Shapes(1).TextFrame.TextRange.Text = "Datos Totales del Servicio"

    'Alineamos el texto

    DiapoPP.Shapes(1).TextFrame.TextRange.ParagraphFormat.Alignment = msoAlignCenter

    'DANDO FORMATO AL TEXTO

    'Usando With / End With

    With DiapoPP.Shapes(1)

        .TextFrame.TextRange.Font.Name = "Times"

        .TextFrame.TextRange.Font.Color = RGB(25, 111, 61)

        '.TextFrame.TextRange.Font.Size = 24

        '.TextFrame.TextRange.Font.Italic = True

        .TextFrame.TextRange.Font.Bold = True

    End With

    'Crear Texto en la forma 2

    'vbnewline nos crea una linea nueva

     'eliminamos la forma para que no se vea el texto que hay detras

    DiapoPP.Shapes(2).Delete

    'CAPTURAS DE LAS TABLAS DINAMICAS COMO BITMAP

    'Pegar un rango como bitmap TABLA1, esta tabla empieza en la misma hoja celda B35

    Range("B35").CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    DiapoPP.Shapes.Paste

    '(se pega en el centro por defecto)

    'tamaño de la tabla como imagen

    AppPP.ActiveWindow.Selection.ShapeRange.Height = 4.71 * CM

    AppPP.ActiveWindow.Selection.ShapeRange.Width = 9.74 * CM

    

    'posicion de la tabla

    AppPP.ActiveWindow.Selection.ShapeRange.Left = 3.29 * CM

    AppPP.ActiveWindow.Selection.ShapeRange.Top = 11.95 * CM

    

    'TABLA DINAMICA 2

    'Pegar un rango como bitmap TABLA1, la segunda tabla empieza en la celda B43

    Range("B43").CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    DiapoPP.Shapes.Paste

    '(se pega en el centro por defecto)

    'tamaño de la tabla como imagen

    AppPP.ActiveWindow.Selection.ShapeRange.Height = 3.91 * CM

    AppPP.ActiveWindow.Selection.ShapeRange.Width = 12.12 * CM

    

    'posicion de la tabla

    AppPP.ActiveWindow.Selection.ShapeRange.Left = 17.91 * CM

    AppPP.ActiveWindow.Selection.ShapeRange.Top = 11.95 * CM

    

    'GRAFICO

    'Pegar gráfico como bitmap

    Sheets("ConexionPowerPoint").ChartObjects("GraficoColumnas").Chart.CopyPicture

    DiapoPP.Shapes.Paste

    

    'ancho del grafico

    AppPP.ActiveWindow.Selection.ShapeRange.Width = 19.13 * CM

        

    'Alineamos

    AppPP.ActiveWindow.Selection.ShapeRange.Left = 7.37 * CM

    AppPP.ActiveWindow.Selection.ShapeRange.Top = 4.38 * CM

End Sub

EXPLICACIÓN:

El valor de X está vez es 4 ya que estamos realizando la cuarta diapositiva.

Luego tenemos la instrucción que nos indicará que tipo de Layout será que esta vez es el 8 que nos insertará un título y un gráfico.

Set DiapoPP = PresentacionPP.slides.Add(Index:=X, Layout:=8)

Luego seguimos insertando el logo, agregamos el texto del título y lo alineamos.

Continuamos dando formato al texto.

Tenemos parte del código que lo que nos hace es copiar como una imagen dos tablas dinámicas.

Este es el código que nos pega la tabla dinámica como imagen

Range("B35").CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    DiapoPP.Shapes.Paste

Si vemos nuestra tabla dinámica empieza en la celda B35 y con el currentRegion nos captura hasta que haya un espacio en la tabla dinámica, por lo que las dos tablas dinámicas tienen que tener entre ellas filas en blanco.

La segunda tabla dinámica empieza en la celda B43 y su código sería:

Range("B43").CurrentRegion.CopyPicture Appearance:=xlScreen, Format:=xlPicture

    DiapoPP.Shapes.Paste

La línea que nos pega el gráfico es la siguiente:

Sheets("ConexionPowerPoint").ChartObjects("GraficoColumnas").Chart.CopyPicture

    DiapoPP.Shapes.Paste

donde GraficoColumnas es el nombre que le hemos dado al gráfico

Así nos ha quedado la Cuarta Diapositiva: