Crea carpetas y guarda archivo con nombre variable en PDF #34

Esta macro de Excel o procedimiento de VBA, se encuentra muy relacionado con la macro que abre libros y posteriormente copia los datos y lo guarda en Csv; la macro que se presenta hoy, crea una carpeta con el nombre del año actual, previamente verifica si la carpteta existe o no, en caso de no existir la crea, una vez realizado esto; verifica en la carpeta creada o ya existente si se encuentra dentro de ella una subcarpeta con el nombre del mes actual; en caso de no existir la crea, en caso de existir, verifica dentro de esta, si existen carpetas con el nombre de cada una de las sucursales de la empresa, en caso negativo crea la carpeta correspondiente a cada sucursal o consolidado si se refiere a la suma de todas las sucursales.

Si bien lo anterior es una parte importante de la macro, no menos importante es la forma de crear el nombre del archivo, el cual es variable, dependiendo de los datos que estemos filtrando en ese momento, ya sea de distintos departamentos o de años anteriores, una vez seleccionados estos datos, se corre la macro que otorga el nombre al libro, llamando al procedimiento explicado en párrafo anterior para determinar la carpeta donde guardar el archivo que es guardado en PDF. En el post copia datos abre otro libro y pega datos, también se puede observar como se trabaja con los distintos directorios donde se encuentran los archivos.

Te recomiendo que leas un excelente libro sobre Excel para ello haz click acá, si quieres un libro sobre Excel, en inglés, entonces debes hacer click acá.

El código que se encuentra a continuación se debe ingresar en un modulo, descargando el ejemplo lo podrás ver en funcionamiento, analizar, modificar y adaptar a lo que tú estés realizando el código está abierto sin ningún tipo de restricción.

Código a insertar en módulo, haciendo click en el link del final podrás descargar el archivo ejemplo

Private Sub BuscayCreaCarpeta()
Dim mes1 As String
Dim mes, año As Integer
‘Estabezco si la carpeta existe
año = Year(Date)
mes = Month(Date)
‘Determino el nombre de la subcarpeta que va dentro de la carpeta año, hay que tener en cuenta que los informes se
‘sacan al mes siguiente, en caso de ser diciembre debería tenerse en cuenta que se saca en enero del año que sigue
‘por ende el directorio donde se guardan los datos es el del año anterior que ya está en teoría creado.
‘Se pone como nombre de mes el anterior al mes actual, ya que los informes se sacan el mes siguiente
Select Case mes
Case 1
mes1 = «Dic»
Case 2
mes1 = «Ene»
Case 3
mes1 = «Feb»
Case 4
mes1 = «Mar»
Case 5
mes1 = «Abr»
Case 6
mes1 = «May»
Case 7
mes1 = «Jun»
Case 8
mes1 = «Jul»
Case 9
mes1 = «Ago»
Case 10
mes1 = «Sep»
Case 11
mes1 = «Oct»
Case 12
mes1 = «Nov»
End Select
‘Se establece que si el mes es diciembre el año donde se guarden los archivos es el actual menos 1 osea el anterior
If mes1 = «Dic» Then
año = año – 1
End If
‘Verifica que la carpeta con el nombre del año se encuentre caso contrario la crea
Path = «C:» & año
If Dir(Path, vbDirectory) = «» Then
MkDir Path
End If

‘Verifica que la carpeta con el nombre del mes se encuentre caso contrario la crea
path1 = «C:» & año & «» & mes1
If Dir(path1, vbDirectory) = «» Then
MkDir path1
End If
‘Verifica que la carpeta con el nombre de la sucursal esta dentro mes del informe
path2 = «C:» & año & «» & mes1 & «Consolidado»
If Dir(path2, vbDirectory) = «» Then
MkDir path2
End If
path3 = «C:» & año & «» & mes1 & «CC»
If Dir(path3, vbDirectory) = «» Then
MkDir path3
End If
path4 = «C:» & año & «» & mes1 & «Suc1»
If Dir(path4, vbDirectory) = «» Then
MkDir path4
End If
End Sub

Private Sub guardapdfGXDpto()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
‘Controlo errores
On Error Resume Next
Sheets(«Graf_por_dpto»).Range(«v2»).Select
Dim filagrafico, dire As String
Dim nomfile, nomsuc As String
Dim x As Integer
‘Establece área de impresión
Range(«b11:j63»).Select
ActiveSheet.PageSetup.PrintArea = Selection.Address

filagrafico = 2
‘Hace que se realice el informe consolidado y por cada sucursal
For x = 2 To 4
Sheets(«Graf_por_dpto»).Range(«d15») = Sheets(«Graf_por_dpto»).Cells(x, 25)
‘Recorre la filas donde está el nombre de los dtos
While Sheets(«Graf_por_dpto»).Cells(filagrafico, 22) <> Empty
Sheets(«Graf_por_dpto»).Range(«e16») = Sheets(«Graf_por_dpto»).Cells(filagrafico, 22)
‘corre procedimiento que hace que filtre las otras columnas, es como apretar el boton consultar de la hoja
BuscayCreaCarpeta
‘Verifica que los datos para el filtro estén cargados caso contrario carga por defecto
If Sheets(«Graf_por_dpto»).Range(«d15») = Empty Then
Sheets(«Graf_por_dpto»).Range(«d15») = «Todas»
End If
‘Determina el nombre del archivo y lo guarda
nomsuc = Sheets(«Graf_por_dpto»).Range(«d15»).Value
If nomsuc = «Todas» Then
nomsuc = «consolidado»
End If

‘Dependiendo la sucursal elegida determina el path correspondiente
Select Case nomsuc
Case «consolidado»
dire = path2
Case «CC»
dire = path3
Case «Suc1»
dire = path4
End Select
nomfile = «Gráfico Vtas de » & Sheets(«Graf_por_dpto»).Range(«e16″).Value & » » & nomsuc
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        dire & «» & nomfile & «.pdf», Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False

filagrafico = filagrafico + 1
Wend
‘vuelvo fila al inicio para que siga con la proxima selección
filagrafico = 2
Next x
Range(«d15»).Select
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

Si te fue de utilidad puedes INVITARME UN CAFÉ y de esta manera ayudar a seguir manteniendo la página, CLICK para descargar en ejemplo en forma gratuita.

If this post was helpful INVITE ME A COFFEE and so help keep up the page, CLICK to download free example.

Si te gustó por favor compártelo con tus amigos
If you liked please share it with your friends