Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- Sub DarFormatoExelsEnFolder()
- 'Revisar todos los archivos xlsx en una carpeta y aplicar formato
- definido
- Dim wb As Workbook
- Dim myPath As String
- Dim myFile As String
- Dim myExtension As String
- Dim FldrPicker As FileDialog
- 'Optimizar Macro
- Application.ScreenUpdating = False
- Application.EnableEvents = False
- Application.Calculation = xlCalculationManual
- 'Definir carpeta destino
- Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
- With FldrPicker
- .Title = "Select A Target Folder"
- .AllowMultiSelect = False
- If .Show <> -1 Then GoTo NextCode
- myPath = .SelectedItems(1) & ""
- End With
- 'Si es cancelado
- NextCode:
- myPath = myPath
- If myPath = "" Then GoTo ResetSettings
- 'Definir extensiones a dar formato
- myExtension = "*.xlsx*"
- 'Definir ruta y extensión
- myFile = Dir(myPath & myExtension)
- 'Revisar todos los archivos en la carpeta
- Do While myFile <> ""
- 'Variable de libro abierto
- Set wb = Workbooks.Open(Filename:=myPath & myFile)
- 'Confirmación de libro abierto
- DoEvents
- 'Cambios al Workbook
- WorkSheetChange
- 'Guardar y cerrar Workbook actual
- wb.Close SaveChanges:=True
- 'Confirmación de libro cerrado
- DoEvents
- 'Proximo libro
- myFile = Dir
- Loop
- 'Aviso de fin de ejecución
- MsgBox "Operación Completada"
- ResetSettings:
- 'Normalizar excel
- Application.EnableEvents = True
- Application.Calculation = xlCalculationAutomatic
- Application.ScreenUpdating = True
- End Sub
- Sub WorkSheetChange00()
- Dim WS As Worksheet
- For Each WS In ThisWorkbook.Worksheets
- Format
- Next WS
- End Sub
- Sub Format()
- 'Format certain cells
- End Sub
Add Comment
Please, Sign In to add comment