davidsuarez.es

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.
[vb]
Call ImportadelExcel(fichero, App.Path & “\midb.mdb”, “ImpExcel”)
[/vb]
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

[vb]
Sub ImportadelExcel(sFichero As String, DS As String, sTablaDestino As String)

Dim sTablaOrigen As String
Dim sConnect As String, sSQL As String
Dim cnnActiva As ADODB.Connection

‘ Establezco la conexión con la base de datos de Access,
‘ la cual será la base de datos “Activa”
Set cnnActiva = New ADODB.Connection
cnnActiva.Open “Provider=Microsoft.Jet.OLEDB.4.0;” & _
“Data Source=” & DS & “;”

‘Rango que quiero importar dela hoja Sheet1
sTablaOrigen = “[Sheet1$A1:C1500]”

‘ Importo la tabla a la base de datos “Activa”
sConnect = “‘” & sFichero & “‘ ‘Excel 8.0;HDR=Yes;’”

sSQL = “SELECT * INTO ” & sTablaDestino & ” FROM ” & sTablaOrigen & ” IN ” & sConnect
cnnActiva.Execute sSQL

‘ Cierro la conexión
cnnActiva.Close
End Sub
[/vb]

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:

[vb]
Private Sub PreparaExcel(sArchivo As String)
‘ Arrancamos Excel
Dim xlapp As Object ‘Aplicacion de Excel
Set xlapp = CreateObject(“Excel.Application”)

‘ La hacemos visible, si comentamos esta linea el excel no se verá
xlapp.Visible = True

‘ Añadimos una hoja de trabajo
Dim xlbook As Object ‘ Hoja de trabajo de Excel
Set xlbook = xlapp.Workbooks.Open(sArchivo)

‘ Ahora añadimos un modulo
Dim xlmodule As Object ‘VBComponent
Set xlmodule = xlbook.VBProject.VBComponents.Add(1)
Msgbox “Creando Macro…”
‘ Añade la macro al nuevo módulo
Dim strCode As String
strCode = _
“sub MiMacro()” & vbCr & _
“Cells.Select” & vbCr & “Selection.UnMerge” & vbCr & _
“Rows(“”1:2″”).Select” & vbCr & _
“Range(“”A2″”).Activate” & vbCr & _
“Selection.Delete Shift:=xlUp” & vbCr & _
“Range(“”A1:C2″”).Select” & vbCr & “Selection.ClearContents” & vbCr & _
“Columns(“”B:B”").Select” & vbCr & _
“Selection.Delete Shift:=xlToLeft” & vbCr & _
“Columns(“”C:J”").Select” & vbCr & _
“Selection.Delete Shift:=xlToLeft” & vbCr & _
“Columns(“”D:Q”").Select” & vbCr & _
“Selection.Delete Shift:=xlToLeft” & vbCr & _
“ActiveWindow.ScrollColumn = 1″ & vbCr & _
“ActiveWindow.ScrollColumn = 2″ & vbCr & _
“ActiveWindow.ScrollColumn = 1″ & vbCr & _
“Range(“”B1″”).Select” & vbCr & _
“Range(“”B1:B1500″”).Select” & vbCr & _
“Selection.Cut Destination:=Range(“”B2:B1501″”)” & vbCr & _
“Columns(“”A:A”").ColumnWidth = 47.86″ & vbCr & _
“Columns(“”B:B”").ColumnWidth = 48.57″ & vbCr & _
“Columns(“”C:C”").ColumnWidth = 12″ & vbCr & _

“ActiveWorkbook.Save” & vbCr & _
“end sub”
xlmodule.CodeModule.AddFromString strCode

‘ Ejecutamos la macro
Msgbox “Ejecutando Macro…”
xlapp.Run “MiMacro”

‘ Acuerdate de liberar el módulo
Set xlmodule = Nothing

‘ Salvamos el fichero y cerramos el Excel
xlbook.Saved = True
xlapp.Quit

End Sub
[/vb]

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

¿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.

[vb]
Sub breakit()

Dim i As Integer, j As Integer, k As Integer
Dim l As Integer, m As Integer, n As Integer

On Error Resume Next
For i = 65 To 66
For j = 65 To 66
For k = 65 To 66
For l = 65 To 66
For m = 65 To 66
For i1 = 65 To 66
For i2 = 65 To 66
For i3 = 65 To 66
For i4 = 65 To 66
For i5 = 65 To 66
For i6 = 65 To 66
For n = 32 To 126

ActiveSheet.Unprotect Chr(i) & Chr(j) & Chr(k) & _
Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) & _
Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)

If ActiveSheet.ProtectContents = False Then
MsgBox “Un password valido es ” & Chr(i) & Chr(j) & _
Chr(k) & Chr(l) & Chr(m) & Chr(i1) & Chr(i2) & Chr(i3) _
& Chr(i4) & Chr(i5) & Chr(i6) & Chr(n)
Exit Sub
End If
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next
Next

End Sub
[/vb]

¿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).

[vb]Sub Crea_Calendario()

‘ Desprotege la hoja si tienes un calendario previo para prevenir el error.
ActiveSheet.Protect DrawingObjects:=False, Contents:=False, _
Scenarios:=False
‘Previene el parpadeo de la ventana mientras se crea el calendario.
Application.ScreenUpdating = False
‘ Control de errores.
On Error GoTo MyErrorTrap
‘ Limpia el area a1:g14 incluyendo cualquier calendario previo.
Range(“a1:g14″).Clear
‘ Usa un InputBox para pedir el mes y año deseado y ponerlo en la variable MyInput.
MyInput = InputBox(“Escribe el mes y el año para el calendario en formato 01/2008 “)
‘ Permite al usuario terminar la macro Cancelando el InputBox.
If MyInput = “” Then Exit Sub
‘ Coge el valor del día del comienzo del mes.
StartDay = DateValue(MyInput)
If Day(StartDay) <> 1 Then
StartDay = DateValue(Month(StartDay) & “/1/” & _
Year(StartDay))
End If
Range(“a1″).NumberFormat = “mmmm yyyy”
‘ Formatea el mes y el año.
With Range(“a1:g1″)
.HorizontalAlignment = xlCenterAcrossSelection
.VerticalAlignment = xlCenter
.Font.Size = 18
.Font.Bold = True
.RowHeight = 35
End With
‘ Formatea los días de la semana.
With Range(“a2:g2″)
.ColumnWidth = 18
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = xlHorizontal
.Font.Size = 12
.Font.Bold = True
.RowHeight = 20
End With
‘ Pone los días de la semana en a2:g2.
Range(“a2″) = “Lunes”
Range(“b2″) = “Martes”
Range(“c2″) = “Miercoles”
Range(“d2″) = “Jueves”
Range(“e2″) = “Viernes”
Range(“f2″) = “Sabado”
Range(“g2″) = “Domingo”
‘ Formatea las celdas a3:g7 para los días.
With Range(“a3:g8″)
.HorizontalAlignment = xlRight
.VerticalAlignment = xlTop
.Font.Size = 18
.Font.Bold = True
.RowHeight = 21
End With
‘ Pone el mes y año indicado en la variable MyInput en “a1″.
Range(“a1″).Value = Application.Text(MyInput, “mmmm yyyy”)
‘ Pone la variable y coge el dia de la semana en el que el mes empieza.
DayofWeek = Weekday(StartDay)
‘ Separa las variables de mes y año en dos variables
CurYear = Year(StartDay)
CurMonth = Month(StartDay)
‘ Calcula el primer día del mes siguiente.
FinalDay = DateSerial(CurYear, CurMonth + 1, 1)
‘ Pone un “1″ en la celda del primer día del mes escogido
Select Case DayofWeek
Case 1
Range(“g3″).Value = 1 ‘ g3 porque empieza por domingo
Case 2
Range(“a3″).Value = 1
Case 3
Range(“b3″).Value = 1
Case 4
Range(“c3″).Value = 1
Case 5
Range(“d3″).Value = 1
Case 6
Range(“e3″).Value = 1
Case 7
Range(“f3″).Value = 1
End Select
‘ Loop para el rango a3:g8 incrementando en 1 a partir del primer “1″.
For Each cell In Range(“a3:g8″)
RowCell = cell.Row
ColCell = cell.Column
‘ Si “1″ está en la primera columna.
If cell.Column = 1 And cell.Row = 3 Then
‘ Si NO está en la primera columna.
ElseIf cell.Column <> 1 Then
If cell.Offset(0, -1).Value >= 1 Then
cell.Value = cell.Offset(0, -1).Value + 1
‘ Se detiene cuando el el último dia del mes se ha colocado.
If cell.Value > (FinalDay – StartDay) Then
cell.Value = “”
Exit For
End If
End If
‘ Solo si la actual celda no está en fila 3 y está en la columna 1.
ElseIf cell.Row > 3 And cell.Column = 1 Then
cell.Value = cell.Offset(-1, 6).Value + 1
‘ Se detiene cuando el el último dia del mes se ha colocado.
If cell.Value > (FinalDay – StartDay) Then
cell.Value = “”
Exit For
End If
End If
Next

‘ Crea las celdas de entrada de datos y las formatea.
For x = 0 To 5
Range(“A4″).Offset(x * 2, 0).EntireRow.Insert
With Range(“A4:G4″).Offset(x * 2, 0)
.RowHeight = 65
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlTop
.WrapText = True
.Font.Size = 10
.Font.Bold = False
‘ Desbloquea estas celdas para insertar texto después porque
‘ la hoja estará protegida.
.Locked = False
End With
‘ Crea el borde alrededor de los días.
With Range(“A3″).Offset(x * 2, 0).Resize(2, _
7).Borders(xlLeft)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With

With Range(“A3″).Offset(x * 2, 0).Resize(2, _
7).Borders(xlRight)
.Weight = xlThick
.ColorIndex = xlAutomatic
End With
Range(“A3″).Offset(x * 2, 0).Resize(2, 7).BorderAround _
Weight:=xlThick, ColorIndex:=xlAutomatic
Next
If Range(“A13″).Value = “” Then Range(“A13″).Offset(0, 0) _
.Resize(2, 8).EntireRow.Delete
‘ Elimina las lineas del grid.
ActiveWindow.DisplayGridlines = False
‘ Protege la hoja para prevenir la sobre escritura de los días.
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, _
Scenarios:=True
‘ Redimensiona la ventana para ver todo el calendario.
ActiveWindow.WindowState = xlMaximized
ActiveWindow.ScrollRow = 1

‘ Permitimos a la ventana reescribirse para ver el calendario.
Application.ScreenUpdating = True
‘ Si no ha ocurrido ningún error aquí acaba la Macro
Exit Sub
‘ Si ha dado error al introducir los datos te muestra un mensaje y te
‘ muestra de nuevo el InputBox para que vuelvas a introducir la fecha.
MyErrorTrap:
MsgBox “No has introducido el mes y el año correctamente.” _
& Chr(13) & “Escribe el mes correctamente” _
& Chr(13) & “y 4 digitos para el año”
MyInput = InputBox(“Escribe el mes y el año correctamente para el calendario”)
If MyInput = “” Then Exit Sub
Resume
End Sub

[/vb]

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.