oct 24

Importar Excel a tabla de Access con Visual Basic.

Visual Basic 24 Comentarios »

Una simple rutina que sirve para importar un rango de filas y columnas de un fichero de Excel a una tabla en una base de datos de Access.

Había probado de multitud de maneras encontradas por internet, ejecutando una macro desde Excel y llamándola desde Visual, intentando crear una macro en access para llamarla desde visual y otros casos mas extraños aún.

La solución era mucho mas sencilla de lo que me esperaba, mediante la biblioteca de ADO.

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Call ImportadelExcel(fichero, App.Path & "\midb.mdb", "ImpExcel")

En el siguiente procedimiento las variables que necesita:

  • sFichero es el fichero Excel que quiero importar
  • DS es el DataSource o ruta a la base de datos que va a importar
  • sTablaDestino el nombre de la tabla que se creará con los datos del Excel
CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Sub ImportadelExcel(sFichero As String, DS As String, sTablaDestino As String)
  2.  
  3. Dim sTablaOrigen As String
  4. Dim sConnect As String, sSQL As String
  5. Dim cnnActiva As ADODB.Connection
  6.  
  7. ' Establezco la conexión con la base de datos de Access,
  8. ' la cual será la base de datos "Activa"
  9. Set cnnActiva = New ADODB.Connection
  10. cnnActiva.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
  11. "Data Source=" & DS & ";"
  12.  
  13. 'Rango que quiero importar dela hoja Sheet1
  14. sTablaOrigen = "[Sheet1$A1:C1500]"
  15.  
  16. ' Importo la tabla a la base de datos "Activa"
  17. sConnect = "'" & sFichero & "' 'Excel 8.0;HDR=Yes;'"
  18.  
  19. sSQL = "SELECT * INTO " & sTablaDestino & " FROM " & sTablaOrigen & " IN " & sConnect
  20. cnnActiva.Execute sSQL
  21.  
  22. ' Cierro la conexión
  23. cnnActiva.Close
  24. End Sub

oct 21

Crear y ejecutar macro de Excel desde Visual Basic.

Visual Basic 2 Comentarios »

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.

ago 14

Desproteger hoja de Excel con contraseña.

Trucos XP, Visual Basic 106 Comentarios »

¿Alguna vez has querido anular la contraseña de una hoja de Excel y no la recordabas?.

Bueno, este truco es muy antiguo pero no por ello menos efectivo. El resultado de aplicar este truco es la obtención de una contraseña valida para desproteger la hoja de excel. Al decir que es una contraseña valida quiero decir que no es la original pero nos permite desbloquearla igualmente.

El truco consiste en una rutina de programación que al ejecutarla (y esperar un rato mientras consigue la contraseña) nos muestra un mensaje con una contraseña válida.

Para ello, el código que pondré a continuación hay que ponerlo en un módulo de visual basic de la aplicación Excel. Lo puedes encontrar en el menú de Excel "Herramientas / Macro / Editor de Visual Basic" o bien pulsando (ALT+F11) para abrir el editor, pegamos el código, cerramos el editor.

Ahora seleccionamos la hoja que queremos desproteger y ejecutamos la macro "breakit" (ALT+F8 para seleccionarla). Tras la ejecución, un mensaje dará una contraseña equivalente, y la hoja ya estará desprotegida.

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Sub breakit()
  2.  
  3.    Dim i As Integer, j As Integer, k As Integer
  4.    Dim l As Integer, m As Integer, n As Integer
  5.  
  6.    On Error Resume Next
  7.      For i = 65 To 66
  8.       For j = 65 To 66
  9.        For k = 65 To 66
  10.         For l = 65 To 66
  11.          For m = 65 To 66
  12.           For i1 = 65 To 66
  13.            For i2 = 65 To 66
  14.             For i3 = 65 To 66
  15.              For i4 = 65 To 66
  16.               For i5 = 65 To 66
  17.                For i6 = 65 To 66
  18.                 For n = 32 To 126
  19.  
  20.    ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
  21.       Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
  22.       Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  23.  
  24.    If ActiveSheet.ProtectContents = False Then
  25.       MsgBox "Un password valido es " & Chr(i) & Chr(j) & _
  26.          Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) _
  27.          & Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
  28.       Exit Sub
  29.    End If
  30.                Next
  31.               Next
  32.              Next
  33.             Next
  34.            Next
  35.           Next
  36.          Next
  37.         Next
  38.        Next
  39.       Next
  40.      Next
  41.     Next
  42.  
  43. End Sub

mar 18

Macro para calendario en Excel.

Scripts, Visual Basic 31 Comentarios »

¿Alguien ha pensado que crear un calendario en excel tenia que ser mas fácil?. Yo también. Aquí tenéis una macro de excel para crearos un calendario del mes que queráis y del año que queráis.

Para utilizar esta macro debéis ir a Herramientas / Macro /Editor de Visual Basic.

Menú Insertar / Modulo y pegar el texto siguiente.

Luego ya solo ejecutar la macro y te lo hace todo solo para el mes que le pongas, por ejemplo, si quieres para este mes has de poner en el InputBox "03/2008" (sin comillas).

CLIC PARA VER TEXTO PLANO
Visual Basic:
  1. Sub Crea_Calendario()
  2.  
  3. ' Desprotege la hoja si tienes un calendario previo para prevenir el error.
  4. ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
  5. Scenarios:=False
  6. 'Previene el parpadeo de la ventana mientras se crea el calendario.
  7. Application.ScreenUpdating = False
  8. ' Control de errores.
  9. On Error GoTo MyErrorTrap
  10. ' Limpia el area a1:g14 incluyendo cualquier calendario previo.
  11. Range("a1:g14").Clear
  12. ' Usa un InputBox para pedir el mes y año deseado y ponerlo en la variable MyInput.
  13. MyInput = InputBox("Escribe el mes y el año para el calendario en formato 01/2008 ")
  14. ' Permite al usuario terminar la macro Cancelando el InputBox.
  15. If MyInput = "" Then Exit Sub
  16. ' Coge el valor del día del comienzo del mes.
  17. StartDay = DateValue(MyInput)
  18. If Day(StartDay) <> 1 Then
  19. StartDay = DateValue(Month(StartDay) & "/1/" & _
  20. Year(StartDay))
  21. End If
  22.  Range("a1").NumberFormat = "mmmm yyyy"
  23. ' Formatea el mes y el año.
  24. With Range("a1:g1")
  25. .HorizontalAlignment = xlCenterAcrossSelection
  26. .VerticalAlignment = xlCenter
  27. .Font.Size = 18
  28. .Font.Bold = True
  29. .RowHeight = 35
  30. End With
  31. ' Formatea los días de la semana.
  32. With Range("a2:g2")
  33. .ColumnWidth = 18
  34. .VerticalAlignment = xlCenter
  35. .HorizontalAlignment = xlCenter
  36. .VerticalAlignment = xlCenter
  37. .Orientation = xlHorizontal
  38. .Font.Size = 12
  39. .Font.Bold = True
  40. .RowHeight = 20
  41. End With
  42. ' Pone los días de la semana en a2:g2.
  43. Range("a2") = "Lunes"
  44. Range("b2") = "Martes"
  45. Range("c2") = "Miercoles"
  46. Range("d2") = "Jueves"
  47. Range("e2") = "Viernes"
  48. Range("f2") = "Sabado"
  49. Range("g2") = "Domingo"
  50. ' Formatea las celdas a3:g7 para los días.
  51. With Range("a3:g8")
  52. .HorizontalAlignment = xlRight
  53. .VerticalAlignment = xlTop
  54. .Font.Size = 18
  55. .Font.Bold = True
  56. .RowHeight = 21
  57. End With
  58. ' Pone el mes y año indicado en la variable MyInput en "a1".
  59. Range("a1").Value = Application.Text(MyInput, "mmmm yyyy")
  60. ' Pone la variable y coge el dia de la semana en el que el mes empieza.
  61. DayofWeek = Weekday(StartDay)
  62. ' Separa las variables de mes y año en dos variables
  63. CurYear = Year(StartDay)
  64. CurMonth = Month(StartDay)
  65. ' Calcula el primer día del mes siguiente.
  66. FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
  67. ' Pone un "1" en la celda del primer día del mes escogido
  68. Select Case DayofWeek
  69. Case 1
  70. Range("g3").Value = 1 ' g3 porque empieza por domingo
  71. Case 2
  72. Range("a3").Value = 1
  73. Case 3
  74. Range("b3").Value = 1
  75. Case 4
  76. Range("c3").Value = 1
  77. Case 5
  78. Range("d3").Value = 1
  79. Case 6
  80. Range("e3").Value = 1
  81. Case 7
  82. Range("f3").Value = 1
  83. End Select
  84. ' Loop para el rango a3:g8 incrementando en 1 a partir del primer "1".
  85. For Each cell In Range("a3:g8")
  86. RowCell = cell.Row
  87. ColCell = cell.Column
  88. ' Si "1" está en la primera columna.
  89. If cell.Column = 1 And cell.Row = 3 Then
  90. ' Si NO está en la primera columna.
  91. ElseIf cell.Column <> 1 Then
  92. If cell.Offset(0, -1).Value>= 1 Then
  93. cell.Value = cell.Offset(0, -1).Value + 1
  94. ' Se detiene cuando el el último dia del mes se ha colocado.
  95. If cell.Value> (FinalDay - StartDay) Then
  96. cell.Value = ""
  97. Exit For
  98. End If
  99. End If
  100. ' Solo si la actual celda no está en fila 3 y está en la columna 1.
  101. ElseIf cell.Row> 3 And cell.Column = 1 Then
  102. cell.Value = cell.Offset(-1, 6).Value + 1
  103. ' Se detiene cuando el el último dia del mes se ha colocado.
  104. If cell.Value> (FinalDay - StartDay) Then
  105. cell.Value = ""
  106. Exit For
  107. End If
  108. End If
  109. Next
  110.  
  111. ' Crea las celdas de entrada de datos y las formatea.
  112. For x = 0 To 5
  113. Range("A4").Offset(x * 2, 0).EntireRow.Insert
  114. With Range("A4:G4").Offset(x * 2, 0)
  115. .RowHeight = 65
  116. .HorizontalAlignment = xlCenter
  117. .VerticalAlignment = xlTop
  118. .WrapText = True
  119. .Font.Size = 10
  120. .Font.Bold = False
  121. ' Desbloquea estas celdas para insertar texto después porque
  122. ' la hoja estará protegida.
  123. .Locked = False
  124. End With
  125. ' Crea el borde alrededor de los días.
  126. With Range("A3").Offset(x * 2, 0).Resize(2, _
  127. 7).Borders(xlLeft)
  128. .Weight = xlThick
  129. .ColorIndex = xlAutomatic
  130. End With
  131.  
  132. With Range("A3").Offset(x * 2, 0).Resize(2, _
  133. 7).Borders(xlRight)
  134. .Weight = xlThick
  135. .ColorIndex = xlAutomatic
  136. End With
  137. Range("A3").Offset(x * 2, 0).Resize(2, 7).BorderAround _
  138. Weight:=xlThick, ColorIndex:=xlAutomatic
  139. Next
  140. If Range("A13").Value = "" Then Range("A13").Offset(0, 0) _
  141. .Resize(2, 8).EntireRow.Delete
  142. ' Elimina las lineas del grid.
  143. ActiveWindow.DisplayGridlines = False
  144. ' Protege la hoja para prevenir la sobre escritura de los días.
  145. ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
  146. Scenarios:=True
  147. ' Redimensiona la ventana para ver todo el calendario.
  148. ActiveWindow.WindowState = xlMaximized
  149. ActiveWindow.ScrollRow = 1
  150.  
  151. ' Permitimos a la ventana reescribirse para ver el calendario.
  152. Application.ScreenUpdating = True
  153. ' Si no ha ocurrido ningún error aquí acaba la Macro
  154. Exit Sub
  155. ' Si ha dado error al introducir los datos te muestra un mensaje y te
  156. ' muestra de nuevo el InputBox para que vuelvas a introducir la fecha.
  157. MyErrorTrap:
  158. MsgBox "No has introducido el mes y el año correctamente." _
  159. & Chr(13) & "Escribe el mes correctamente" _
  160. & Chr(13) & "y 4 digitos para el año"
  161. MyInput = InputBox("Escribe el mes y el año correctamente para el calendario")
  162. If MyInput = "" Then Exit Sub
  163. Resume
  164. End Sub

Si hemos creado una macro en excel y la quitamos al volver a abrir el documento sigue apareciendo una molesta ventana que dice que el documento tiene macros cuando no existe ninguna macro:

Menu Herramientas, Macro, Editor Visual Basic, menú ver explorador de proyectos, botón derecho sobre cada modulo y quitar.

Si nos preguntar guardar y no lo queremos le decimos que no.

La próxima vez que abramos el documento ya no nos preguntará si queremos habilitar los macros.

WP Theme & Icons originales por N.Design Studio.
Aviso Legal Entradas RSS Comentarios RSS Acceder