La empresa PUMA S.A. con la cual
estoy desarrollando el proyecto del curso, trabaja sus bases de datos en Excel,
es por esto que la macro que genere traspasa los datos a un archivo Access.
Esto permitiría trabajar los datos de manera más eficiente permitiendo la
generación de reportes e ingreso de los datos por medio de formularios. Si esto
se replica en todos los proyectos de PUMA S.A. esto permitirá tener toda la
información en una sola base de datos, información que sería vital para la sede
central de PUMA ubicada en la región metropolitana.
En el siguiente link podras bajar
los archivos necesarios.
https://mega.co.nz/#!yFww1JjC!tEN5hkgwbtcnkyKmygKz0UZVknAc2FGil-NlbsENXiY
La macro se divide en 2 partes:
1.-Generacion de las tablas en
Excel
2.- Traspaso a Access.
Paso 1: Generación de tablas en
Excel
El Excel donde está contenida la
macro previamente tiene generada tablas de Personal, Turnos y Personal_Turnos.
Estas serán las tablas que se exportaran al la base de datos Access. Con esto
dicho, nos encontraremos con el botón generar base la cual tiene el siguiente
código:
Sub macroblog()
'Abre el archivo de origen
On Error GoTo
ControlDeError
Application.ScreenUpdating = False
Worksheets("Total").Visible =
True
Worksheets("Total").Select
Cells.Select
Selection.Clear
Worksheets("Turnos").Select
Cells.Select
Selection.Clear
Worksheets("Personal").Select
Cells.Select
Selection.Clear
Worksheets("Personal_Turno").Select
Cells.Select
Selection.Clear
Dim RutaArchivo As String
On Error Resume Next
RutaArchivo =
Application.GetOpenFilename(Title:="Abrir", _
filefilter:="Excel files (*.xls), *.xls")
If RutaArchivo = "Falso" Then
Worksheets("Total").Visible =
False
Worksheets("Macro").Select
Else
Workbooks.Open Filename:=RutaArchivo
Worksheets("MAESTRO").Select
Cells.Select
Selection.Copy
Windows("Macro.xlsm").Activate
Worksheets("Total").Select
Range("A1").Select
ActiveSheet.Paste
Worksheets("Macro").Select
Este código abre una ventana emergente la cual da
la opción de buscar la base de datos en Excel previamente echa.
La base de datos tiene un aspecto como el de la figura 1
pero de todas formas la base esta en los archivos del link
En base a esta hoja de Excel el código de la macro continúa
permitiendo separar los datos en las tablas antes mencionadas:
'Crea la talba
personal
Application.ScreenUpdating = False
Range("D3").Select
Sheets("Personal").Select
Cells.Select
Application.CutCopyMode = False
Selection.Clear
Sheets("Total").Select
Range("D3:I3").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal").Select
Range("B2").Select
ActiveSheet.Paste
Columns("B:B").EntireColumn.AutoFit
Columns("B:G").Select
Columns("B:G").EntireColumn.AutoFit
Range("A1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "Rut"
Range("A2").Select
ActiveCell.FormulaR1C1 =
"=RC[1]&""-"""
Range("A2").Select
ActiveCell.FormulaR1C1 =
"=RC[1]&""-""&RC[2]"
Range("A2").Select
Selection.AutoFill
Destination:=Range("A2:A173")
Range("A2:A173").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Columns("B:C").Select
Selection.Delete Shift:=xlToLeft
Range("B1").Select
ActiveCell.FormulaR1C1 = "Apellido
M"
Range("C1").Select
ActiveCell.FormulaR1C1 = "P"
Range("B1").Select
ActiveCell.FormulaR1C1 =
"Apellido P"
Range("C1").Select
ActiveCell.FormulaR1C1 =
"Apellido M"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Nombres
"
Range("E1").Select
ActiveWindow.SmallScroll Down:=47
ActiveWindow.LargeScroll Down:=-2
Range("E1").Select
ActiveCell.FormulaR1C1 = "Cargo"
Range("A1").Select
Range(Selection,
Selection.End(xlToRight)).Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("B2").Select
Range(Selection, Selection.End(xlDown)).Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Font.Bold = False
Range("A1:E1").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("A1").Select
ActiveWindow.SmallScroll ToRight:=0
ActiveWindow.SmallScroll Down:=34
ActiveWindow.LargeScroll Down:=1
ActiveWindow.SmallScroll Down:=63
ActiveWindow.LargeScroll Down:=-2
ActiveWindow.SmallScroll Down:=-12
ActiveWindow.LargeScroll Down:=-1
ActiveWindow.SmallScroll Down:=-27
ActiveWindow.LargeScroll Down:=-1
'Crea la tabla turnos
Application.ScreenUpdating = False
Sheets("Turnos").Select
Cells.Select
Selection.Clear
Sheets("Total").Select
Range("K3").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Turnos").Select
Range("B2").Select
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Range("$B$2:$B$173").RemoveDuplicates Columns:=1,
Header:=xlNo
Range("A1").Select
ActiveCell.FormulaR1C1 =
"Id_Turno"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Cod"
Range("C1").Select
ActiveCell.FormulaR1C1 =
"Días trabajo"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Días
Descanso"
Range("D2").Select
Columns("D:D").EntireColumn.AutoFit
Range("B1").Select
Selection.AutoFilter
ActiveWorkbook.Worksheets("Turnos").AutoFilter.Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Turnos").AutoFilter.Sort.SortFields.Add
Key:=Range _
("B1:B6"),
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With
ActiveWorkbook.Worksheets("Turnos").AutoFilter.Sort
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "2"
Range("A4").Select
ActiveCell.FormulaR1C1 = "3"
Range("A5").Select
ActiveCell.FormulaR1C1 = "4"
Range("A6").Select
ActiveCell.FormulaR1C1 = "5"
Range("A2").Select
ActiveCell.FormulaR1C1 = "1"
Range("A3").Select
ActiveCell.FormulaR1C1 = "2"
Range("A4").Select
ActiveCell.FormulaR1C1 = "3"
Range("A2:A4").Select
Selection.AutoFill
Destination:=Range("A2:A6")
Range("A2:A6").Select
Range("C2").Select
ActiveCell.FormulaR1C1 =
"=extrae"
Range("C2").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 =
"=LEFT(RC[-1],5)"
Range("C2").Select
ActiveCell.FormulaR1C1 =
"=MID(RC[-1],4,2)"
Range("C2").Select
Selection.AutoFill
Destination:=Range("C2:C6")
Range("C2:C6").Select
Range("C2").Select
ActiveCell.FormulaR1C1 =
"=MID(RC[-1],4,2)"
Range("C2").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "AUX"
Range("E2").Select
ActiveCell.FormulaR1C1 =
"=IF(RIGHT(RC[-2],1)=""-"",LEFT(RC[-2],1))"
Range("E2").Select
ActiveCell.FormulaR1C1 =
"=IF(RIGHT(RC[-2],1)=""-"",LEFT(RC[-2],1),RC[-2])"
Range("D2").Select
ActiveCell.FormulaR1C1 = "1"
Range("D2").Select
Selection.Copy
Range("D3").Select
Range(Selection,
Selection.End(xlDown)).Select
Range(Selection,
Selection.End(xlUp)).Select
Selection.End(xlDown).Select
Selection.End(xlUp).Select
Range("C2").Select
Selection.End(xlDown).Select
Range("C7").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "1"
Range("D7").Select
ActiveCell.FormulaR1C1 = "1"
Range("E7").Select
ActiveCell.FormulaR1C1 = "1"
Range("D2").Select
Selection.AutoFill
Destination:=Range("D2:D6")
Range("D2:D6").Select
Range("E2").Select
Selection.AutoFill
Destination:=Range("E2:E6")
Range("E2:E6").Select
Selection.Copy
Range("C2").Select
Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Columns("E:E").Select
Application.CutCopyMode = False
Selection.ClearContents
Range("C2").Select
Selection.End(xlDown).Select
Range(Selection,
Selection.End(xlToRight)).Select
Selection.ClearContents
Range("D6").Select
Selection.End(xlUp).Select
Range("D2").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = _
"=IF(RC[-1]=""14"",7,IF(RC[-1]=""5"",2,IF(RC[-1]=""9"",5,0)))"
Range("D2").Select
Selection.AutoFill
Destination:=Range("D2:D6")
Range("D2:D6").Select
Selection.AutoFilter
Range("A1").Select
Range(Selection,
Selection.End(xlToRight)).Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1").Select
Range(Selection,
Selection.End(xlToRight)).Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End
With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("C2").Select
Range(Selection,
Selection.End(xlDown)).Select
Range("D2").Select
ActiveCell.FormulaR1C1 =
"=IF(RC[-1]=""14"",7,IF(RC[-1]=""5"",2,IF(RC[-1]=""9"",5,0)))"
Range("D2").Select
Selection.AutoFill
Destination:=Range("D2:D6")
Range("D2:D6").Select
Range("E4").Select
'crea la tabla personal turnos
Sheets("Personal_Turnos").Active
ActiveCell.FormulaR1C1 = "Id_Per_Tur"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Rut"
Range("C1").Select
ActiveCell.FormulaR1C1 =
"Id_Turno"
Range("A2").Select
Sheets("Total").Select
Range("A3").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal_Turno").Select
ActiveSheet.Paste
Sheets("Total").Select
ActiveWindow.SmallScroll Down:=-17
Range("C145").Select
Selection.End(xlUp).Select
ActiveWindow.SmallScroll Down:=-1
ActiveWindow.LargeScroll Down:=-1
Range("D3").Select
Range(Selection,
Selection.End(xlDown)).Select
Application.CutCopyMode = False
ActiveWindow.SmallScroll Down:=-2
Range("D3").Select
Range(Selection,
Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range("D3:E3").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal_Turno").Select
Range("E1").Select
ActiveSheet.Paste
Range("B2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 =
"=R[-1]C[3]&""-""&R[-1]C[4]"
Range("B2").Select
Selection.AutoFill
Destination:=Range("B2:B173")
Range("B2:B173").Select
Selection.Copy
Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("E1:F1").Select
Range(Selection,
Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("D1").Select
ActiveCell.FormulaR1C1 =
"Fecha_Contratacion"
Range("D2").Select
Sheets("Total").Select
ActiveWindow.SmallScroll Down:=-3
ActiveWindow.LargeScroll Down:=-7
Range("C3").Select
Range(Selection,
Selection.End(xlToLeft)).Select
Range("C3").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal_Turno").Select
ActiveSheet.Paste
Range("D2").Select
Sheets("Total").Select
ActiveWindow.SmallScroll Down:=-6
ActiveWindow.LargeScroll Down:=-1
ActiveWindow.SmallScroll Down:=-36
ActiveWindow.LargeScroll Down:=-1
ActiveWindow.SmallScroll Down:=-41
ActiveWindow.LargeScroll Down:=-1
ActiveWindow.SmallScroll Down:=-1
Range("C4").Select
Application.CutCopyMode = False
Range("C5").Select
ActiveWindow.SmallScroll ToRight:=0
Columns("K:K").Select
Columns("K:K").EntireColumn.AutoFit
Range("K3").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal_Turno").Select
Range("F2").Select
ActiveSheet.Paste
Sheets("Turnos").Select
Range("A2:A6").Select
Application.CutCopyMode = False
Selection.Copy
Range("E2").Select
ActiveSheet.Paste
Range("E10").Select
Sheets("Personal_Turno").Select
Range("C2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 =
"=VLOOKUP(RC[3],Turnos!R2C2:R6C5,4,0)"
Range("C2").Select
Selection.AutoFill
Destination:=Range("C2:C173")
Range("C2:C173").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues,
Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F1").Select
Range(Selection,
Selection.End(xlDown)).Select
Range(Selection,
Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.ClearContents
Range("E1:F1").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Clear
Range("A1:D1").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1:D1").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Range("E8").Select
' Crea tabla personal Turnos
'
Sheets("Personal_Turno").Select
Cells.Select
Selection.Clear
Range("A1").Select
ActiveCell.FormulaR1C1 = "Id_Per_Tur"
Range("B1").Select
ActiveCell.FormulaR1C1 = "Rut"
Range("C1").Select
ActiveCell.FormulaR1C1 =
"Id_Turno"
Range("D1").Select
ActiveCell.FormulaR1C1 =
"Fecha_contratacion"
Range("D2").Select
Sheets("Total").Select
Range("A3").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal_Turno").Select
Range("A2").Select
ActiveSheet.Paste
Range("C22").Select
Sheets("Total").Select
Range("D157").Select
Selection.End(xlUp).Select
Range("D3").Select
Range(Selection,
Selection.End(xlToRight)).Select
Selection.End(xlToLeft).Select
Range("B3").Select
Application.CutCopyMode = False
Sheets("Personal").Select
Range("A2").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal_Turno").Select
Range("B2").Select
ActiveSheet.Paste
Range("C2").Select
Sheets("Turnos").Select
Columns("E:E").Select
Application.CutCopyMode = False
Selection.ClearContents
Selection.Clear
Range("A2:A6").Select
Selection.Copy
Range("E2").Select
ActiveSheet.Paste
Sheets("Total").Select
Range("K3").Select
Range(Selection,
Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Personal_Turno").Select
Range("F2").Select
ActiveSheet.Paste
Range("C2").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 =
"=VLOOKUP(RC[3],Turnos!R2C2:R6C5,4,0)"
Range("C2").Select
Selection.AutoFill
Destination:=Range("C2:C173")
Range("C2:C173").Select
Range("C2").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Selection.PasteSpecial
Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F2").Select
Range(Selection,
Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Clear
Range("D2").Select
ActiveCell.FormulaR1C1 = ""
Sheets("Total").Select
ActiveWindow.LargeScroll Down:=-7
Range("C3").Select
Range(Selection,
Selection.End(xlDown)).Select
Selection.Copy
Sheets("Personal_Turno").Select
ActiveSheet.Paste
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection,
Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlMedium
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A1:D1").Select
Selection.Font.Bold = True
Selection.Borders(xlDiagonalDown).LineStyle
= xlNone
Selection.Borders(xlDiagonalUp).LineStyle =
xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("G2").Select
Worksheets("Total").Visible =
False
End If
ControlDeError:
End Sub
Con las tablas generadas podemos continuar al
siguiente paso.
Paso2: Traspaso a Acces.
Para este paso es necesario tener
previamente creada la base de datos que para el caso se llamara “Base
trabajadores”, con las tablas respectivas y muy importante : sin atributos
clave. Esta debe ser guardada como base compatible con office 2003 esto para efectos
de la conexión que necesitaremos realizar más adelante.
Con esto el código que presento a
continuación permite conectar el archivo Excel con la base de datos y a la vez
copiar los datos en las respectivas tablas:
Public Cn As New
Connection
Public rs1 As New
Recordset
Public rs2 As New
Recordset
Public rs3 As New
Recordset
Public Rstemp As New
Recordset
Sub Exportar()
Dim Cn As
ADODB.Connection, rs As ADODB.Recordset, n As Long
Dim nrango As String
Sheets("Macro").Activate
Application.ScreenUpdating
= False
Sheets("Turnos").Activate
If [A2] = Empty Then
MsgBox
prompt:="No hay datos para exportar", Buttons:=vbOKOnly + vbCritical,
Title:="Campos vacios"
Exit Sub
End If
Set Cn = New
ADODB.Connection
Cn.Open
"provider=microsoft.jet.oledb.4.0; " & "data source="
& ThisWorkbook.Path & "\Base Trabajadores.mdb;"
Set rs1 = New
ADODB.Recordset
rs1.Open
"Turnos", Cn, adOpenKeyset, adLockOptimistic, adCmdTable
n = 2
Do While
Range("A" & n) <> Empty
With rs1
.AddNew
.Fields("Id_Turno")
= Range("A" & n).Value
.Fields("Cod")
= Range("B" & n).Value
.Fields("Días
Trabajo") = Range("C" & n).Value
.Fields("Días
Descanso") = Range("D" & n).Value
End With
n = n + 1
Loop
With rs1
.AddNew
.Fields("Id_Turno")
= Range("A" & n).Value
.Fields("Cod")
= Range("B" & n).Value
.Fields("Días
Trabajo") = Range("C" & n).Value
.Fields("Días
Descanso") = Range("D" & n).Value
End With
Set rs1 = Nothing
Sheets("Personal").Activate
If [A2] = Empty Then
MsgBox
prompt:="No hay datos para exportar", Buttons:=vbOKOnly + vbCritical,
Title:="Campos vacios"
Exit Sub
End If
Set rs2 = New
ADODB.Recordset
rs2.Open
"Personal", Cn, adOpenKeyset, adLockOptimistic, adCmdTable
p = 2
Do While
Range("A" & p) <> Empty
With rs2
.AddNew
.Fields("Rut")
= Range("A" & p).Value
.Fields("Apellido
P") = Range("B" & p).Value
.Fields("Apellido
M") = Range("C" & p).Value
.Fields("Nombres")
= Range("D" & p).Value
.Fields("Cargo")
= Range("D" & p).Value
End With
p = p + 1
Loop
With rs2
.AddNew
.Fields("Rut")
= Range("A" & p).Value
.Fields("Apellido
P") = Range("B" & p).Value
.Fields("Apellido
M") = Range("C" & p).Value
.Fields("Nombres")
= Range("D" & p).Value
.Fields("Cargo")
= Range("D" & p).Value
End With
Set rs2 = Nothing
Sheets("Personal_Turno").Activate
If [A2] = Empty Then
MsgBox
prompt:="No hay datos para exportar", Buttons:=vbOKOnly + vbCritical,
Title:="Campos vacios"
Exit Sub
End If
Set rs3 = New
ADODB.Recordset
rs3.Open
"Personal_Turno", Cn, adOpenKeyset, adLockOptimistic, adCmdTable
q = 2
Do While
Range("A" & q) <> Empty
With rs3
.AddNew
.Fields("Id_Per_Tur")
= Range("A" & q).Value
.Fields("Rut")
= Range("B" & q).Value
.Fields("Id_Turno")
= Range("C" & q).Value
.Fields("Fecha_Contratacion")
= Range("D" & q).Value
End With
q = q + 1
Loop
With rs3
.AddNew
.Fields("Id_Per_Tur")
= Range("A" & q).Value
.Fields("Rut")
= Range("B" & q).Value
.Fields("Id_Turno")
= Range("C" & q).Value
.Fields("Fecha_Contratacion")
= Range("D" & q).Value
End With
Set rs3 = Nothing
Cn.Close
Set Cn = Nothing
MsgBox prompt:="Los datos fueron enviados correctamente", Buttons:=vbOKOnly,
Title:="DATOS EXPORTADOS"
Exit Sub
End Sub
Public Sub Conectar()
Cn.Provider =
"Microsoft.Jet.Oledb.4.0"
Cn.Open
(ThisWorkbook.Path + "\Base Trabajadores.mdb")
End Sub
Public Sub main()
Call Conectar
End Sub
