Necesito generar múltiples archivos de forma automatizada
Me da mucho gusto saber que existe un foro de ayuda, no tenia idea de la existencia de este sitio, me parece GENIAL!. Necesito de su ayuda, requiero de una macro de automatización, que tiene como objetivo seleccionar un archivo ppt(de 150 diapositivas) que debe ser enviada a mas de 100 personas, pero este documentos debe ser personalizado al momento de enviarse para cada persona, donde señale en algún lugar de la diapositiva el nombre de quien recibe el documento con el siguiente texto "USO EXCLUSIVO DE <NOMBRE DE LA PERSONA>.
Para esto utilizo una bbd de excel con 3 columnas, Nombre, Carga, Correo y una ppt con 3 slider (deben ser 150, pero estoy probando con 3 por el momento), donde se combinan estos dos archivos creando un archivo nuevo de nombre Combinados.pptx todo esto a través de una macro. El problema que me ocurre es que no se donde definir o como especificar que me replique en todas las slider el nombre de la primera persona, luego me guarde el documento y vuelva a abrir el archivo ppt, pero ahora continúe con la segunda persona y así, hasta los mas de 100 cargos que debe llegar este documento, pero el otro problema que me surge es como le indico que deben ser archivos individuales, ósea de un archivo ppt (llamémoslo ppt base) me arroje 100 archivos ppt con cada nombre que requiero. Recurro a su amplia experiencia para modificar dicha macro o contar con un nuevo botón que me permita realizar lo anterior.
Adjunto la macro, que no me dejaba por máximo caracteres
Sub Combina()
Dim shtHoja1 As Worksheet
'Declaramos las variables que seria las columnas del excel
Dim strNOMBRE As String
Dim strCARGO As String
Dim strCORREO As String
Dim filaInicial As Long
'Creamos nuestras variables de tipo objeto
Dim objPPT As Object
Dim objPres As Object
Dim objSld As Object
Dim objShp As Object
'Llamamos la hoja en donde bamos a obtener los datos y se lo asignamos al objeto shtHoja1
Set shtHoja1 = Worksheets("Hoja1")
Set objPPT = CreateObject("Powerpoint.Application")
objPPT.Visible = True
'Buscamos la plantilla que en este caso se llama constancia la cual se encuentra en el mismo directorio que el archivo de excel'
'y se lo asignamos al objeto objPres
Set objPres = objPPT.presentations.Open("C:\Users\ext_ghernandezf\Desktop\combinar\modelando\Prueba.pptm")
'una vez asignada la plantilla Constnacias al objeto objPres guardamos el objeto con el nombre de combinados.pptx
objPres.SaveAs ThisWorkbook.Path & "\combinados.pptx"
'Esta variable nos indicara donde iniciar a obtener los datos, en este caso a partir de la fila 2'
filaInicial = 2
'Creamos un ciclo, la instrucción es que, mientras en la variable filainicial y columna 1 sea diferente (<>) a campo vacío hacer los siguiente'
Do While shtHoja1.Cells(filaInicial, 1) <> ""
'obtenemos el dato de la filainicial, columna 1 y se lo asignamos a la variable strNombre'
strNOMBRE = shtHoja1.Cells(filaInicial, 1)
'obtenemos el dato de la filainicial, columna 2 y se lo asignamos a la variable strCargo'
strCARGO = shtHoja1.Cells(filaInicial, 2)
'obtenemos el dato de la filainicial, columna 3 y se lo asignamos a la variable strCorreo'
strCORREO = shtHoja1.Cells(filaInicial, 3)
'del objeto objPres (combinados.pptx) duplicamos la primera diapositiva o slide y se lo asignamos al objSld
Set objSld = objPres.slides(1).Duplicate
'ahora hara un recorrido de las formas que contenga la diapositiva, supongo que los cuadros de texto y demas tipos de objetos que se puedan insertar
For Each objShp In objSld.Shapes
'si la forma es un cuadro de texto
If objShp.HasTextFrame Then
'si la forma cuadro de texto tiene texto'
If objShp.TextFrame.HasText Then
'reemplazar el texto"<fecha>" del cuadro de texto por lo que contiene la variable strNombre y asi sucesivamente
objShp. TextFrame. TextRange. Replace "<nombre>", strNOMBRE
objShp. TextFrame. TextRange. Replace "<cargo>", strCARGO
objShp. TextFrame. TextRange. Replace "<correo>", strCORREO
End If
End If
Next
'con esta instruccion nos aseguramos de pasar a la siguiente fila de la hoja de excel'
filaInicial = filaInicial + 1
Loop
'ahora borramos la diapositiva que nos sirvio como plantilla'
objPres.slides(1).Delete
'guardamos los cambio que se hicieron en la diapositiva "combinados.pptx'
objPres.Sabe
'cerramos la diapositiva'
objPres.Close
End Sub
