Sumario automático PowerPoint 2013

Re,

Estoy mirando la cosa

Hasta luego

Re,

línea en negrita para el índice de la diapositiva

 'bucle sobre todas las diapositivas a partir de la 2ª
 For y = 2 To ActivePresentation.Slides.Count
 Set Diapo = ActivePresentation.Slides(y)
 'si la diapositiva tiene un título
 If Diapo.Shapes.HasTitle Then
 Set titre = Diapo.Shapes.Title
 texto_ajout = texto_ajout & Format(y, "00 ") & titre.TextFrame.TextRange.Text & Chr(13)
 End If
 Next y

Merci pour vos réponses,

Sin embargo, tengo un problema porque tengo varios títulos que son idénticos en ciertas diapositivas, y me gustaría que cuando el título de la diapositiva N sea idéntico al de la diapositiva N-1, no se añada una línea en el índice, y que solo se agregue un intervalo de página (tipo "p.6 - 10)

Aquí está el código que he hecho con una paginación que funciona, ¿tendría alguna solución para este problema?

¡Muchas gracias!

Sub sommaire()

Dim Diapo As Slide
Dim titre As Shape
Dim texte_ajout As TextRange
Dim texte_sommaire As TextRange
Dim ligne_sommaire As TextRange
Dim y As Byte

' añade una diapositiva al inicio de la presentación con
' la disposición de título n°2 de la plantilla
ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
With ActivePresentation.Slides(1)
.Shapes(1).TextFrame.TextRange = "Índice"
Set texte_ajout = .Shapes(2).TextFrame.TextRange
End With

'bucle sobre todas las diapositivas a partir de la segunda
For y = 2 To 23
Set Diapo = ActivePresentation.Slides(y)
'si la diapositiva tiene un título
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte_ajout = texte_ajout & titre.TextFrame. _
TextRange.Text & " (p." & Diapo.SlideNumber & ")" & Chr(13)
End If
Next y

'añadiendo enlaces a los elementos del índice
Set texte_sommaire = _
ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange

'creación de hiperenlaces a los títulos
'si no desea que haya, suprimir los párrafos siguientes

For y = 2 To 23
Set Diapo = ActivePresentation.Slides(y)
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte = titre.TextFrame.TextRange.Text
Set ligne_sommaire = texte_sommaire.Find(FindWhat:=texte)
With ligne_sommaire
.ActionSettings(ppMouseClick).Hyperlink.SubAddress = _
Diapo.SlideID & "," & Diapo.SlideIndex & "," & texte
End With
End If
Next

Gracias, funciona (casi) a la perfección, excepto por un pequeño problema de paginación cuando los títulos son idénticos, me muestra esto:

Manual de Contabilidad (p.2)
1. Introducción (p.5)
2. Definiciones (p.6)
3. Políticas contables del grupo (p.7 - 8)

(p.9 - 16)
4. Cuenta de pérdidas y ganancias (p.17)
4.1 Ingresos (p.18)
4.1.1.1 Productos (p.19)
4.1.1.2 Ingeniería no recurrente (p.20 - 23)

¿Puede estar relacionado con el hecho de que los títulos no tienen el mismo formato? (tamaño, por ejemplo)

¡Muchas gracias!

Re,

No sé, en mi casa no hay problema, tomé un archivo al azar y está bien. Necesitaría su archivo solo con las diapositivas que tienen los títulos si hay información confidencial.

Bonjour,

¡Efectivamente, este problema parece resuelto!
Ahora tengo dificultades para formatear este índice.
Quisiera que la paginación aparezca al final de la frase y esté alineada a la derecha, y también que aparezca una tabulación para las subpartes y las sub-subpartes, así:

1. Introducción p.3
2. XX p.4
3. Principios contables p.5
3.1 Subparte 1 de principios contables p.6
3.1.1 Sub-subparte 1 de principios contables p.7

Ya tengo una idea para las tabulaciones, creo que podríamos lograrlo con
si hay 1 número, sin tabulación
si hay 2 números en el título, 1 tabulación, etc.

pero no puedo hacerlo con la sintaxis VBA. ¡No logro integrar todas las diapositivas en el índice! Intenté "from 3 to ActivePresentation.Slides.Count" en el bucle, pero PowerPoint se bloquea cuando ejecuto la macro :(

aquí está mi código:

Sub sommaire()

Dim Diapo As Slide, Diapo1 As Slide
Dim titre As Shape
Dim texte_ajout As TextRange
Dim texte_sommaire As TextRange
Dim ligne_sommaire As TextRange
Dim y As Byte

'Si el título de la primera diapositiva es "Índice", será eliminada
'esto permite volver a ejecutar la macro tantas veces como se desee
'sin tener que eliminar la diapositiva de índice
If ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = "Índice" Then
ActivePresentation.Slides(1).Delete
End If

' añade una diapositiva al principio de la presentación con
'la disposición de título número 2 de la plantilla
ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
With ActivePresentation.Slides(1)
.Shapes(1).TextFrame.TextRange = "Índice"
Set texte_ajout = .Shapes(2).TextFrame.TextRange
End With

On Error Resume Next

'bucle sobre todas las diapositivas a partir de la 2ª
For y = 3 To 23

Set Diapo = ActivePresentation.Slides(y)
Set Diapo1 = ActivePresentation.Slides(y + 1)

'si la diapositiva tiene un título
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
Set titre1 = Diapo1.Shapes.Title
If titre.TextFrame.TextRange.Text <> titre1.TextFrame.TextRange.Text Then
texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & Diapo.SlideNumber & ")" & Chr(13)
Else
prem = Diapo.SlideNumber
Cmpt = prem
Do While titre.TextFrame.TextRange.Text = titre1.TextFrame.TextRange.Text
Cmpt = Cmpt + 1
Set Diapo1 = ActivePresentation.Slides(Cmpt)
Set titre1 = Diapo1.Shapes.Title

Loop
texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & prem & " - " & Cmpt - 1 & ")" & Chr(13)
y = Cmpt - 1
End If
End If
Next y
'adición de enlaces a los elementos del índice
Set texte_sommaire = ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange

'creación de hiperenlaces hacia los títulos
'si no los desea, elimine los siguientes párrafos
For y = 3 To 23
Set Diapo = ActivePresentation.Slides(y)
If Diapo.Shapes.HasTitle Then
Set titre = Diapo.Shapes.Title
texte = titre.TextFrame.TextRange.Text
Set ligne_sommaire = texte_sommaire.Find(FindWhat:=texte)
With ligne_sommaire
.ActionSettings(ppMouseClick).Hyperlink.SubAddress = _
Diapo.SlideID & "," & Diapo.SlideIndex & "," & texte
End With
End If
Next

End Sub

¿Hay alguna manera de enviar archivos a través de esta plataforma?

¡Gracias de antemano!

Hola,

Para poner un archivo a disposición, haz clic en el siguiente enlace: https://www.cjoint.com/

No olvides copiar/pegar el enlace creado en tu próximo mensaje

¡Hasta luego!

¡Gracias!

Aquí está el enlace:

https://www.cjoint.com/?DGkjSeLOR0a

¡Muchas gracias!

Re,

recupero su archivo y le mantendré informado.

¡Hasta luego!

Re,

archivo con función de título de tabulación. Si es posible, pasar la tabulación a 3 o 4 caracteres, puede ir. A ver. ¡Problema con el segundo slide y los dos últimos! ¡!!!!!!!!!!!!!!!!

https://www.cjoint.com/c/DGklS6KLQyX

para el encuadre del número de páginas, espero su respuesta sobre el archivo.

Hola,

debería estar bien, he eliminado el somario si está presente para evitar la multiplicación de somarios

Sub sommaireSophie_Grml()
 Dim Diapo As Slide, Diapo1 As Slide
 Dim titre As Shape
 Dim texte_ajout As TextRange
 Dim texte_sommaire As TextRange
 Dim ligne_sommaire As TextRange
 Dim y As Byte
 
 'Si el título de la primera diapositiva es "Somario", se eliminará
 'esto permite ejecutar la macro tantas veces como se desee
 'sin tener que eliminar la diapositiva de somario
 If ActivePresentation.Slides(1).Shapes(1).TextFrame.TextRange = "Somario" Then
 ActivePresentation.Slides(1).Delete
 End If

 ' agrega una diapositiva al inicio de la presentación con
 ' la disposición de título n°2 de la plantilla
 ActivePresentation.Slides.Add Index:=1, Layout:=ppLayoutText
 With ActivePresentation.Slides(1)
 .Shapes(1).TextFrame.TextRange = "Somario"
 Set texte_ajout = .Shapes(2).TextFrame.TextRange
 End With

 On Error Resume Next

 'bucle sobre todas las diapositivas a partir de la 2ª
 For y = 2 To 23
 Set Diapo = ActivePresentation.Slides(y)
 Set Diapo1 = ActivePresentation.Slides(y + 1)
 
 'si la diapositiva tiene un título
 If Diapo.Shapes.HasTitle Then
 Set titre = Diapo.Shapes.Title
 Set titre1 = Diapo1.Shapes.Title
 If titre.TextFrame.TextRange.Text <> titre1.TextFrame.TextRange.Text Then
 texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & Diapo.SlideNumber & ")" & Chr(13)
 Else
 prem = Diapo.SlideNumber
 Cmpt = prem
 Do While titre.TextFrame.TextRange.Text = titre1.TextFrame.TextRange.Text
 Cmpt = Cmpt + 1
 Set Diapo1 = ActivePresentation.Slides(Cmpt)
 Set titre1 = Diapo1.Shapes.Title
 Loop
 texte_ajout = texte_ajout & titre.TextFrame.TextRange.Text & " (p." & prem & " - " & Cmpt - 1 & ")" & Chr(13)
 y = Cmpt - 1
 End If
 End If
 Next y
 'añadiendo enlaces a los elementos del somario
 Set texte_sommaire = ActivePresentation.Slides(1).Shapes(2).TextFrame.TextRange

 'creación de hipervínculos hacia los títulos
 'si no los desea, elimine los párrafos a continuación
 For y = 2 To 23
 Set Diapo = ActivePresentation.Slides(y)
 If Diapo.Shapes.HasTitle Then
 Set titre = Diapo.Shapes.Title
 texte = titre.TextFrame.TextRange.Text
 Set ligne_sommaire = texte_sommaire.Find(FindWhat:=texte)
 With ligne_sommaire
 .ActionSettings(ppMouseClick).Hyperlink.SubAddress = _
 Diapo.SlideID & "," & Diapo.SlideIndex & "," & texte
 End With
 End If
 Next
End Sub

Bonjour,

http://fr.viadeo.com/fr/groups/detaildiscussion/?containerId=0021el8i9qpyom60&forumId=0022kc3dpxpaoo2&action=messageDetail&messageId=002umvaexyixkxo