A veces nos es muy tediosa la forma de preparar determinada información para ser explotada entre las aplicaciones Excel y otros programas o bases de datos.

Hoy voy a dejar aqui plasmado para quien lo necesite y para mi mismo si en alguna otra ocasión necesito tirar de ello de nuevo, la forma de crear desde Visual Basic una Macro de Excel y ejecutarla después.

Sin duda podemos encontrar por la red multitud de formas de ejecutar una macro ya existente en un fichero de Excel desde visual Basic pero ¿que ocurre si la macro la necesitamos ejecutar no está en el libro de Excel y debemos tratar multitud de ficheros?

La única forma es grabar la macro en el fichero antes de ejecutarla y todo ello desde Visual Basic. A continuación os expongo el procedimiento que yo mismo he utilizado.

Primero he creado la macro necesaria en Excel asegurándome del buen funcionamiento de la misma. Hay que tener claro que si cometemos un error, este será trasladado a todos los ficheros que tratemos.

Cuando ya la tenemos la forma de utilizarla en un procedimiento sería la siguiente:

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Private Sub PreparaExcel(sArchivo As String)
  2. ' Arrancamos Excel
  3. Dim xlapp As Object 'Aplicacion de Excel
  4. Set xlapp = CreateObject("Excel.Application")
  5.  
  6. ' La hacemos visible, si comentamos esta linea el excel no se verá
  7. xlapp.Visible = True
  8.  
  9. ' Añadimos una hoja de trabajo
  10. Dim xlbook As Object ' Hoja de trabajo de Excel
  11. Set xlbook = xlapp.Workbooks.Open(sArchivo)
  12.  
  13. ' Ahora añadimos un modulo
  14. Dim xlmodule As Object 'VBComponent
  15. Set xlmodule = xlbook.VBProject.VBComponents.Add(1)
  16. Msgbox "Creando Macro..."
  17. ' Añade la macro al nuevo módulo
  18. Dim strCode As String
  19. strCode = _
  20. "sub MiMacro()" & vbCr & _
  21. "Cells.Select" & vbCr & "Selection.UnMerge" & vbCr & _
  22. "Rows(""1:2"").Select" & vbCr & _
  23. "Range(""A2"").Activate" & vbCr & _
  24. "Selection.Delete Shift:=xlUp" & vbCr & _
  25. "Range(""A1:C2"").Select" & vbCr & "Selection.ClearContents" & vbCr & _
  26. "Columns(""B:B"").Select" & vbCr & _
  27. "Selection.Delete Shift:=xlToLeft" & vbCr & _
  28. "Columns(""C:J"").Select" & vbCr & _
  29. "Selection.Delete Shift:=xlToLeft" & vbCr & _
  30. "Columns(""D:Q"").Select" & vbCr & _
  31. "Selection.Delete Shift:=xlToLeft" & vbCr & _
  32. "ActiveWindow.ScrollColumn = 1" & vbCr & _
  33. "ActiveWindow.ScrollColumn = 2" & vbCr & _
  34. "ActiveWindow.ScrollColumn = 1" & vbCr & _
  35. "Range(""B1"").Select" & vbCr & _
  36. "Range(""B1:B1500"").Select" & vbCr & _
  37. "Selection.Cut Destination:=Range(""B2:B1501"")" & vbCr & _
  38. "Columns(""A:A"").ColumnWidth = 47.86" & vbCr & _
  39. "Columns(""B:B"").ColumnWidth = 48.57" & vbCr & _
  40. "Columns(""C:C"").ColumnWidth = 12" & vbCr & _
  41.  
  42. "ActiveWorkbook.Save" & vbCr & _
  43. "end sub"
  44. xlmodule.CodeModule.AddFromString strCode
  45.  
  46. ' Ejecutamos la macro
  47. Msgbox "Ejecutando Macro..."
  48. xlapp.Run "MiMacro"
  49.  
  50. ' Acuerdate de liberar el módulo
  51. Set xlmodule = Nothing
  52.  
  53. ' Salvamos el fichero y cerramos el Excel
  54. xlbook.Saved = True
  55. xlapp.Quit
  56.  
  57. End Sub

A disfrutarla con salud que a mi me ha costado un poco llegar a ella.


Posts anterior y posterior:
«
»


Posts Relacionados: