Guest User

Untitled

a guest
Dec 13th, 2017
66
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.64 KB | None | 0 0
  1. Sub DarFormatoExelsEnFolder()
  2. 'Revisar todos los archivos xlsx en una carpeta y aplicar formato
  3. definido
  4.  
  5. Dim wb As Workbook
  6. Dim myPath As String
  7. Dim myFile As String
  8. Dim myExtension As String
  9. Dim FldrPicker As FileDialog
  10.  
  11. 'Optimizar Macro
  12. Application.ScreenUpdating = False
  13. Application.EnableEvents = False
  14. Application.Calculation = xlCalculationManual
  15.  
  16. 'Definir carpeta destino
  17. Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)
  18.  
  19. With FldrPicker
  20. .Title = "Select A Target Folder"
  21. .AllowMultiSelect = False
  22. If .Show <> -1 Then GoTo NextCode
  23. myPath = .SelectedItems(1) & ""
  24. End With
  25.  
  26. 'Si es cancelado
  27. NextCode:
  28. myPath = myPath
  29. If myPath = "" Then GoTo ResetSettings
  30.  
  31. 'Definir extensiones a dar formato
  32. myExtension = "*.xlsx*"
  33.  
  34. 'Definir ruta y extensión
  35. myFile = Dir(myPath & myExtension)
  36.  
  37. 'Revisar todos los archivos en la carpeta
  38. Do While myFile <> ""
  39. 'Variable de libro abierto
  40. Set wb = Workbooks.Open(Filename:=myPath & myFile)
  41.  
  42. 'Confirmación de libro abierto
  43. DoEvents
  44.  
  45. 'Cambios al Workbook
  46.  
  47. WorkSheetChange
  48.  
  49. 'Guardar y cerrar Workbook actual
  50. wb.Close SaveChanges:=True
  51.  
  52. 'Confirmación de libro cerrado
  53. DoEvents
  54.  
  55. 'Proximo libro
  56. myFile = Dir
  57. Loop
  58.  
  59. 'Aviso de fin de ejecución
  60. MsgBox "Operación Completada"
  61.  
  62. ResetSettings:
  63. 'Normalizar excel
  64. Application.EnableEvents = True
  65. Application.Calculation = xlCalculationAutomatic
  66. Application.ScreenUpdating = True
  67.  
  68. End Sub
  69.  
  70. Sub WorkSheetChange00()
  71. Dim WS As Worksheet
  72.  
  73. For Each WS In ThisWorkbook.Worksheets
  74.  
  75. Format
  76.  
  77. Next WS
  78.  
  79. End Sub
  80.  
  81. Sub Format()
  82.  
  83. 'Format certain cells
  84.  
  85. End Sub
Add Comment
Please, Sign In to add comment